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ABSTRACT 


An  investigation  of  the  Trade  Wind  Duct  was  carried  out  from  6  March 
through  25  March  19^9  in  the  Northern  part  of  the  Caribbean  Sea.  An  in¬ 
strumented  aircraft  was  used  to  record  meteorological  and  radio  refractivity 
data  in  digitized  format  for  computer  analysis.  In  addition,  extensive  radio¬ 
sonde  data  was  included  in  the  analysis  to  support  the  aircraft  measurements 
and  provide  a  basis  for  weather  analysis.  In  order  to  assimilate,  process 
and  present  such  a  large  amount  of  data  it  was  imperative  that,  machine  pro¬ 
cessing  be  used.  The  following  report  describes  the  various  programs 
which  were  used  in  the  analysis  and  presentation  of  the  data.  A  ray-tracing 
program  was  also  developed  to  analyze  radio  wave  propagation  in  relation  to 
Trade  Wind  Duct  characteristics.  This  program  has  the  advantage  that 
horizontal  changes  in  the  Duct  can  be  included.  Most  ray-tracing  programs 
assume  that  the  vertical  variation  of  refractivity  is  spherically  stratified. 
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SECTION  I 
INTRODUCTION 


This  report  describes  the  computer  programs  that  were  used  in  pro¬ 
cessing  the  data  collected  for  this  contract. 

A  brief  summary  of  this  processing  is  as  follows: 


PAPTOMAG: 

QUACK:' 

RAWCON: 


PLOT: 


TRACE: 


Converts  aircraft  paper  tape  to  magnetic  tape. 
Pre-processes  radiosonde  data. 

Processes  output  of  PAPTOMAG.  Converts  this  to 
atmospheric  profiles. 

Plots  atmospheric  profiles.  Use  output  of  QUACK 
RAWCON. 

Performs  ray-tracing  and  produces  plots. 


All  the  above  except  PAPTOMAG  are  written  primarily  in  FORTRAN 
IV  and  run  on  an  IBM  7094.  PAPTOMAG  is  written  in  assembly  language  for 
an  SDS-930.  QUACK  and  RAWCON  contain  small  input  and  utility  routines 
written  in  assembly  language.  PLOT  and  TRACE  make  use  of  assembly 
language  routines  to  produce  plotting  tapes  for  a  Stromberg -Carlson  4020. 

PAPTOMAG,  PLOT,  and  TRACE  were  written  specifically  for  this 
project,  RAWCON  is  a  modification  of  a  program  originally  written  at 
MITRE  Corporation  for  an  IBM  7030.  QUACK  was  supplied  by  the  sponsor. 
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SECTION  II 
PAPTOMAG 


This  program  converts  the  paper  tape  containing  the  airplane  measure 
ments  to  7 -track  magnetic  tape.  It  is  written  in  assembly  language  for  an 
SDS-930  equipped  with  a  paper  tape  reader  and  tape  drive  on  the  W  buffer. 

The  program  takes  three  8 -bit  characters  from  the  paper  tape  and  writes 
them  as  four  6-bit  characters  on  the  tape.  The  end  of  the  paper  tape  roll  is 
indicated  by  five  consecutive  blank  frames.  Records  on  magnetic  tape  are 
1524  characters  long.  (The  last  record  of  a  roll  may  be  short,  ) 

The  program  is  organized  to  put  multiple  rolls  of  paper  tape  on  a 
single  magnetic  tape.  The  paper  tapes  are  organized  as  missions.  Several 
rolls  may  make  up  a  mission.  The  missions  may  be  put  on  the  proper  tape 
in  any  order,  but  all  rolls  from  a  single  mission  must  be  put  on  together  and 
in  order.  The  output  tape  is  on  Unit  1. 

At  various  times  in  the  processing,  the  program  will  type  messages 
and  wait  for  a  response.  The  only  valid  responses  are  Y  or  N  followed  by  a 
carriage  return.  If  any  other  response  is  given  the  program  will  request  the 
response  be  re-entered. 

The  following  are  the  messages  and  appropriate  responses. 

IS  THIS  A  NEW  MAG  TAPE. 

This  message  is  always  typed  at  the  beginning  of  each  program. 
Responses: 

Y  The  program  should  start  at  the  beginning  of  the  magnetic 

tape. 

N  Missions  have  been  put  on  the  magnetic  tape  previously.  The 

program  will  skip  to  the  end  of  the  last  mission  already  on  the 
magnetic  tape. 

ARE  THERE  MORE  ROLLS  FOR  THIS  MISSION. 

ARE  there  more  MISSIONS  FOR  THIS  MAGNETIC  TAPE. 

ARE  there  more  MAGNETIC  TAPES. 
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END  OF  magnetic  TAPE.  RESTART  LAST  MISSICN  . 


No  response  is  needed  to  this  message.  Since  all  rolls  of  a  single 
mission  must  be  on  the  same  tape,  this  message  is  typed  when  an  end  of 
magnetic  tape  is  found.  The  operator  should  restart  the  first  roll  of  the 
mission  currently  being  converted  after  readying  a  new  tape  1. 

The  program  will  print  what  is  being  put  on  magnetic  tape  unless 
sense  switch  2  is  set.  For  normal  processing,  therefore,  this  sense  switch 
should  be  set. 

Since  no  identification  appears  on  the  tape,  it  is  very  important  that 
an  accurate  record  be  kept  of  which  paper  tapes  have  been  converted. 

In  case  of  trouble,  the  following  is  relevant  for  repositioning.  There 
is  1  EOF  between  each  roll  of  a  mission;  2  EOFs  between  each  mission; 

3  EOFs  at  the  end  of  a  tape. 
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SECTION  III 


QUACK 

The  purpose  of  the  program  "QUACK"  is  to  read  and  find  tropospheric 
ducts  from  the  B4  hydro  tapes,  obtained  from  the  Environmental  Tactical  Air 
Command  (ETAC),  located  at  the  Washington  Naval  Yard.  These  tapes  con¬ 
tain  worldwide  radiosonde  and  pilot  balloon  soundings  and  aircraft  information. 

The  decks  and  relative  location  in  the  program  "QUACK"  and  a  short 
explanation  of  their  purpose  are  as  follows; 


A.  WORK 

Reads  the  B4  hydro  tape  and  converts  the  data 
into  a  useable  form.  It  also  compiles  statistical 
information  concerning  the  soundings  for  all 
stations  for  each  month. 

B.  QT 

Calculates  the  characteristics  of  tropospheric 
ducts.  If  a  duct  exists  the  program  outputs  the 
location,  time,  height,  thickness,  and  re- 
fractivity  gradient  of  the  duct. 

C.  HGT 

Given  two  readings  of  pressure,  temperature, 
and  dew  point,  calculates  the  height  difference 
between  these  levels. 

D.  INDX 

Given  the  pressure,  temperature,  and  dew 
point,  calculates  the  refractivity. 

E.  DECOD  Unpacks  each  word  of  an  array  into  six  words 


each  containing  one  character. 

F.  HELP 

Reads  a  variable  length  record  until  it  finds  a 
record  mark  or  until  it  reads  a  maximum  of 

315  words.  It  counts  the  number  of  words  read 
and  flags  it.  Finds  an  end  of  file. 

G.  PR 

Flags  appropriate  counters  when  examining  the 
pressure  levels  of  a  sounding  for  a  given  station. 
The  counters  are  for  first  pressure  LT  850, 
mandatory  levels  only,  mandatory  and  significant 
levels,  and  mandatory  levels  and  surface  pressure 
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3.  1  Input 


The  program  uses  units  B(l)  and  B(<d)  for  input  tape  units.  The  pro¬ 
gram  initially  uses  unit  B(l),  and  if  the  operator  desires  to  use  another  in¬ 
put  tape,  through  proper  use  of  the  sense  switches,  the  program  will  then  use 
unit  B(2).  If  other  input  tapes  are  desired,  the  program  then  transfers  be¬ 
tween  unit  B(l)  and  B(2).  The  format  of  the  input  data  (the  B4  hydro  tape) 
follows : 


A.  contents  and  format  of  upper  air  data  on  B4 
HYDRO  TAPE 

( 1 )  UNC  LASSIFIED 

(2)  BCD  MODE 

(3)  800  BPI  density,  IN  UNPACKED  FORM 

(4)  BLOCKED  ONE  REPORT  PER  PHYSICAL  RECORD. 
LOGICAL  RECORDS  CONSIST  OF  20  DATA  WORDS 
PLUS  A  606060606072  WORD,  PSEUDO  RECORD  MARK 

(5)  ALL  NUMERIC  WORDS  ARE  RIGHT  ADJUSTED  WITH 
LEAD  BLANKS 

(6)  .  THE  WORD  "PIBAL"  REFERS  TO  ANY  REPORT  CON¬ 

TAINING  ONLY  WIND  INFORMATION 

(7)  DATA  ALTERED  DURING  CHECKING  ARE  FLAGGED 
ACCORDINGLY. 

(A)  RAOB  HEIGHTS  OR  TEMPERATURES  (FLAG 
LEFT  ADJUSTED) 

R  =  recomputed  data 

E  =  EXTRAPOLATED  DATA 

(B)  WINDS,  WHEN  INCONSISTENT,  ARE  REMOVED 
AND  A  "D"  REPLACES  THE  DIRECTION 
(RIGHT  ADJUSTED). 

(8)  ALL  DATA  IN  ALPHA-NUMERIC  FORMAT 
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B.  TIME  RECORD  CONTAINS  FOUR  WORDS  AND  IS  THE  FIRST 
RECORD  ON  the  TAPE. 

(1)  HOUR  -  BASIC  DATA  TIME 

\ 

(2)  DAY  -  DAY  OF  MONTH 

(3)  MONTH  -  NUMERICAL  VALUE  (1  JAN) 

(4)  YEAR  -  LAST  TWO  DIGITS  (66  =  1966) 

NOTE.  A  "$'■  INDICATES  A  BLANK  CHARACTER 

c.  identification,  in  each  record,  except  time 

RECORD,  THE  FIRST  8  DATA  WORDS  ARE  USED  TO  IDENTIFY 

the  report  by  type,  time,  and  location. 

(1)  type  of  report  -  RAOB$$,  PIBAL$$,  AGFT$$ 

(2)  BLOCK  AND  STATION 

(A)  00000  IF  ROVING  SHIP 

(B)  NAME  IF  PERMANENT  SHIP  (4YA) 

(C )  mil  FOR  LAND  STATION 

(D)  00000  AIRCRAFT  WITH  NON-SPOT  WIND,  77 
AIRCRAFT  with  SPOT  WIND. 

(3)  TIME  -  HOUR 

(4)  DAY  -  DAY  OF  MONTH 

(5)  month  -  NUMERICAL  (1  JAN) 

(6)  LATITUDE  -  IN  HUNDREDTHS  OF  DEGREES  (NO 
DECIMAL  POINT) 

(7)  LONGITUDE  -  IN  HUNDREDTHS  OF  DEGREES  (NO 
DECIMAL  POINT) 

(8)  ELEVATION  -  WHOLE  METERS  (0  FOR  ROVING 
SHIPS  AND  AIRCRAFT) 
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D.  DATA  FORMAT 

(1)  RAOBS  -  6  WORDS  DESCRIBE  EACH  POINT  OF  A 
SOUNDING.  ALL  POINTS  (SIG  AND  MANDATORY) 

ARE  IN  LOGICAL  DESCENDING  PRESSURE  ORDER. 

THE  SIX  WORD  FORMAT  IS  REPEATED  AS  MANY 
TIMES  AS  NEEDED  FOR  THE  COMPLETE  REPORT. 

(A)  PRESSURE  -  WHOLE  NUMBERS 

(B)  HEIGHT  -  TENS  OF  FEET  (0  IS  SIG  POINT) 

(C)  TEMPERATURE  -  SIGNED  TO  TENTHS  OF 
DEGREE  WITH  DECIMAL  POINT 

(D)  DEW  POINT  -  SIGNED  TO  TENTHS  OF  DEGREE 
WITH  DECIMAL  POINT 

(E)  WIND  DIRECTION  -  TO  TENS  OF  DEGREE 
(0  IS  SIG  POINT) 

(F)  WIND  SPEED  -  TO  WHOLE  KNOTS  (0  IS  SIG 
POINT) 

(G)  AFTER  THE  LAST  POINT  OF  THE  RAOB  COMES 
THE  TROP  INFORMATION  IN  A  FOUR  WORD 
FORMAT 

((!))  TROP  $$  -  identifier 

((2))  TROP  PRESSURE  -  WHOLE  MB'S 

((3))  TROP  HEIGHT  -  TENS  OF  FEET 

((4))  TROP  temperature  -  TENTHS  OF 
DEGREE  WITH  DECIMAL  POINT 

(H)  NEXT  IS  SF  (PRESSURE  IN  A  TWO  WORD 
FORMAT). 

((!))  SPRESR  -  IDENTIFIER 

((2))  SFC  PRESSURE  -  WHOLE  MB'S 
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(I)  AND  LAST  IS  MAXIMUM  WIND  INFORMATION 
IN  A  FOUR  WORD  FORMAT.  (ONLY  WINDS  AT 
OR  BELOW  44000  FEET  ARE  CONSIDERED.  ) 

((!))  MAXWIND  -  IDENTIFIER 

((2))  HEIGHT  -  TENS  OF  FEET 

((3))  WIND  DIRECTION  -  TO  TENS  OF  DEGREE 

((4))  WIND  SPEED  -  TO  WHOLE  KNOTS 

(J)  WORDS  2,  3,  AND  4  WILL  BE  0  (ZERO)  IF  NO 
WINDS  BELOW  44000. 

(2)  PIBALS.  NEXT  26  WORDS  FOLLOWING  I.  D.  IN¬ 
FORMATION  ARE  WINDS  FOR  THE  1 3  STANDARD 
LEVELS  (1000,  850,  700,  500,  300,  250,  200,  150, 

100,  050,  030,  010)  TWO  WORDS  PER  LEVEL. 

(A)  WIND  DIRECTION  -  TENS  OF  DEGREES 

(B)  WIND  SPEED  -  WHOLE  KNOTS 

AFTER  THE  STANDARD  LEVEL  WINDS  ARE  THE 
WORDS  $TOTAL  $PIBAL.  FOLLOWING  THIS  IS  A 

complete  list  of  all  the  pibal  winds  in  a 

TWO  WORD  FORMAT  REPEATED  AS  MANY  TIMES 
AS  NEEDED  FOR  THE  COMPLETE  RUN. 

(A)  HEIGHT  -  IN  THOUSANDS  OF  FEET 

(B)  WIND  -  DIRECTION  AND  SPEED  •($DD$FF) 

((1))  LEFT  3  CHARACTERS  -  WIND 

DIRECTION  IN  TENS  OF  DEGREES 

((2))  RIGHT  3  characters  -  SPEED  IN 
WHOLE  KNOTS 

(3)  ACFT.  WORDS  after  I.  D.  AS  FOLLOWS: 

(A)  PRESSURE  LEVEL  -  WHOLE  MB'S 
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(B)  HEIGHT  OF  STANDARD  LEVEL  -  TENS  OF 
FEET  (FROM  RECCO  ONLY) 

(C)  TEMPERATURE  -  TO  TENTHS  OF  DEGREE 
WITH  DECIMAL  POINT  (FROM  RECCO  ONLY) 

(D)  WIND  DIRECTION  -  TENS  OF  DEGREES 

(E)  WIND  SPEED  -  KNOTS 

(F)  TRUE  ALTITUDE  -  HUNDREDS  OF  FEET 

(G)  ICING  -  $000RT 

R  =  RATE  OF  ICING 
T  =  TYPE  OF  ICING 

(H)  FLIGHT  CONDITION  AND  TURBULENCE  - 

$OWFCBK 

w  =  weather 

F  =  FLIGHT  CONDITION 
B  =  TURBULENCE  INTENSITY 

K  =  character  of  turbulence 

PARAMETER  REPORTED  IN  WORDS  SEVEN 
AND  EIGHT  ARE  CONVERTED  TO  RECCO 
CODE  UNITS  WITH  EXCEPTION  W  -  3  DE¬ 
NOTES  BROKEN  CLOUD  COVER 

(I)  CLOUDS  (LOWEST  LAYER  REPORTED  $NBBTT) 
N  =  AMOUNT  OF  CLOUDS 

BB  =  BASES 
TT  =  TOPS 

WORDS  10,  11,  AND  12  (SAME  FORMAT  AS  9) 
WILL  BE  USED  AS  NEEDED  TO  DESCRIBE 
MULTIPLE  LAYERS. 
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IF  5  OR  MORE  LAYERS  ARE  REPORTED  WORD 
12  WILL  BE  THE  HIGHEST  LEVEL  REPORTED. 
IN  WORD  7  THROUGH  12  THE  "  SYMBOL 
WILL  DENOTE  A  MISSING  ELEMENT. 

E.  SEQUENCE  OF  REPORTS 

(1)  ROVING  SHIPS  (BLOCK  AND  STATION  =  0)  BY  LATI¬ 
TUDE  AND  LONGITUDE. 

(2)  PERMANENT  SHIPS  BY  NAME  (4YA,  4YB,  ETC.  ) 

(3)  LAND  STATION  BY  BLOCK  AND  STATION  NUMBER. 
WHEN  A  STATION  HAS  BOTH  A  RAOB  AND  PIBAL 
THE  RAOB  PRECEDES  THE  PIBAL. 

(4)  AIRCRAFT  REPORTS  BY  LATITUDE  AND  LONGITUDE. 

3 .  2  Output 

There  are  several  outputs  produced  by  QUACK.  Only  one  of  them  was 
used  in  this  project. 

For  each  launch  processed,  three  logical  binary  records  are  produced 
on  FORTRAN  UNIT  11. 

RECORD  1.  Nine  (six-character)  words . 

Words  1-7  are  station  number,  latitude,  longitude,  station  elevation, 
launch  hour,  launch  day,  and  launch  month.  The  words  are  BCD  right  ad¬ 
justed  with  leading  blanks.  Words  8-9  are  binary  integers  which  describe 
the  second  record. 

RECORD  2.  2000  words. 

This  record  contains  a  4  x  500  floating  point  array:  each  row  of  four 
numbers  contains  temperature  (°  C),  dew  point  (°  C),  height  (m),  refractivity 
(M  units). 

Word  8  of  record  1  is  the  row  number  of  the  first  row  of  the  array 
containing  valid  information.  Word  9  of  record  1  is  the  row  number  of  the 
last  row  of  the  array  containing  valid  information. 

RECORD  3  is  not  relevant. 
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SECTION  IV 
RAWCON 


The  index  of  refraction  at  a  point  in  the  atmosphere  may  be  obtained 
directly  by  taking  a  refractometer  reading  at  that  point,  or  it  may  be  com¬ 
puted  indirectly  from  the  temperature,  pressure,  and  humidity  values. 

The  primary  function  of  the  program  RAWCON  is  to  accept  refracto¬ 
meter  and  atmospheric  data  from  airborne  observations  and  to  compute  the 
refractivity  from  this  information.  The  principal  output  is  then  the  re- 
fractivity  as  a  function  of  the  altitude.  The  program  also  produces  such  out¬ 
put  as  potential  temperature,  potential  index,  vapor  pressure,  and  mixing 
ratio.  It  produces  both  a  printed  listing  and  secondary  output  which  can  be 
used  for  further  processing. 

The  program  provides  the  user  with  the  choice  of  computing  re¬ 
fractivity  by  either  the  direct  or  the  indirect  method.  An  option  for  producing 
output  on  punched  cards  is  also  provided.  The  program  accepts  atmospheric 
input  data  through  magnetic  tape.  Any  information  punched  onto  paper  tape 
must  be  converted  to  magnetic  tape  before  it  can  be  used  by  RAWCON. 

This  program  is  based  entirely  on  a  program  written  at  MITRE 
Corporation.  This  program  is  described  in  MITRE  working  paper  919^. 

This  description  is  largely  a  reproduction  of  this  working  paper.  Sections 
which  have  not  been  changed  are  indicated  by  an  after  the  section  title. 

4.  1  Computations 

4.  1.  1  Basic  Computations* 

Rather  than  computing  the  index  of  refraction,  n,  this  program  will 
deal  with  the  refractivity,  N,  which  is  defined  by 

N  =  (n  -  1)  10® 


1.  Beebe,  Otto  W.,  "REFCOL,  A  Data  Reduction  Program  for  the  Genera¬ 
tion  of  Refractivity  Profiles,  "  Mitre  Corporation  WP919.  9  November  1966. 
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The  relation  between  the  refractivity,  N,  and  the  various  atnnospheric 
parameters  is  given  by 


N 


77.  6  I 


+  3.73x10®  ^ 


(1) 


where  T  =  Temperature  in  °  K. 

P  =  Pressure  in  millibars. 

e  =  Partial  pressure  of  water  vapor  in  millibars. 

Suppose  that,  for  the  "direct"  refractometer  calculation,  the  variation 
of  frequency  with  respect  to  refractivity  is  9.245  kc/N.  Suppose  further  that: 

ho  =  Initial  height. 

Fg  =  Reference  frequency  at  ho. 

Ng  =  Reference  refractivity  corresponding  to  Fg. 

F  =  Frequency  observed  at  height  h. 

Then  the  difference  in  refractivity  (AN)  between  height  ho  and  height 
h  is  given  by 


AN 


F  -  Fs 

9.  245 


Refractivity  at  height  h  is  then: 

N  =  Ng  -  AN  (2) 

From  (1)  and  (2)  the  vapor  pressure  e  can  be  computed  by 

T^  (N  -  77.6  ^  ) 

®  3.73  X  10® 


The  mixing  ratio,  r,  is  defined  by 

. 62l97e 
^  P  -  e 
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The  geopotential  height  (Z)  is  computed  by  the  following  formulas; 


Zj  -  ho 

~  ^k+i 

[^k  (>  -  0.  388  (l  +  0.  388  ^')]  (^) 

for  k  =  1,  2,  3,  . 


where 


ek 

A 

R 


=  Beginning  height. 

=  Pressure  (mb)  for  k^th  reading. 

=  Temperature  (°  K)  for  k^th  reading. 

=  Vapor  pressure  (mb)  for  k^th  reading. 
=  Length  of  semi-major  axis  (km). 

=  Length  of  semi-minor  axis  (km). 


The  potential  temperature,  Tp, 
3/7 


Tp=T(i|20) 


-  273. 16 


is  given  by; 


The  potential  index  K  is  given  by: 

0.  714 


4.1.2  Input  and  Corrections* 

All  paranaeters  which  are  received  from  magnetic  tape  are  converted 
by  the  input  routines  into  a  four  digit  floating  point  representation.  In  order 
to  be  of  use  in  the  computations,  further  scaling  and  corrections  must  be 
performed. 

The  following  parameters  are  received  as  input  from  magnetic  tape: 
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1. 

T  ime 

2. 

Frequency  (Kc,  Refractometer  No. 

1). 

3. 

Frequency  (Kc,  Refractometer  No. 

2). 

4. 

Frequency  (Kc,  Refractometer  No. 

3). 

5. 

Altitude  (radar  interval  counter). 

6. 

Event. 

7. 

Air  Speed. 

8. 

Pressure. 

9. 

KS4  Temperature. 

10. 

EK  Temperature. 

11. 

Humidity. 

12. 

Voltage  (Refractometer  No.  4). 

13. 

Vortex  Temperature. 

The  temperature,  air  speed  and  pressure  values  are  in  a  linear  re¬ 
lation  with  their  final  floating  point  representation  and  are  converted  by  a 
linear  function  (TLIN).  The  user  establishes  the  conversion  functions  which 
are  to  be  employed.  The  user  also  specifies  correction  constants  for  these 
parameters . 

The  program  applies  a  further  correction  to  the  value  of  the  selected 
temperature  probe.  Suppose  Tg  is  the  value  of  the  selected  probe,  then 

T  =  (Tg  +  273.  16)/(1  +  B^S) 

where 

r  1,  if  KS4  probe 
k  =  <  2,  if  EK  probe 

3,  if  Vortex  probe 

is  an  input  parameter  =  speed  corrections  for  temperature  probes 

^  SPEED® 

^  ■  P 

T  =  temperature  in  ^  K  and  will  be  used  in  all  computations  involving 
temperature  . 
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The  following  corrections  are  made  to  the  refractivity  computations: 
F  -  F 

AN  =  +  a  [T  (1  +  S)  -  To  ] 

Oi  =  Temperature  correction  for  cavity  expressed  in  N  units /°  C. 

(This  correction  varies  from  time  to  time.  ) 

where  ot,  are  correction  constants  supplied  by  user. 

Tq  =  Surface  temperature  in  °  K. 

The  "uncorrected"  value  for  refractivity  is  then  given  by: 

N  =  Ns  -  An 

The  "wet"  term  of  N  is  computed  by: 

^  ..  Cs  77.  6P 

n-wet  =  ^3  ^  cT  “  ’"'t 

where  =  1  +  3.  5  jSs  S  (jSs  supplied  by  user,  ) 

C3  =  1  +  ^5  S 

The  vapor  pressure  e  is  then: 

NweT 

®  3. 73  X  10® 

and  the  final  "corrected”  value  for  refractivity  is  given  by: 

N*  =  77.  6 

4.  2  Magnetic  Tape  Format 

The  IBM  7094  has  seven  track  tapes  and  a  36-bit  word.  The  paper 
tape  has  8-bit  characters.  The  8-bit  characters  are  packed  without  any 
slack  bits  .  Thus,  nine  characters  are  packed  in  two  words.  The  magnetic 
tape  contains  no  information  except  a  representation  of  the  paper  tapes. 

Within  missions,  paper  tapes  are  separated  by  file  marks.  Missions 
are  separated  by  double  file  marks,  and  the  end  of  the  tape  is  delineated  by 
a  triple  file  mark. 
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The  tape  is  set  up  on  IBSYS  unit  A(l). 


The  following  table  gives  the  legal  8 -bit  paper  tape  codes  and  their 
meaning.  Any  other  codes  which  appear  on  the  paper  tape  are  considered 
e  rrors . 


Paper  Tape 
(Octal  Representation) 

001 

002 

023 

004 

025 

026 

007 

010 

031 

040 

200 

4.  3  Control  Card  Parameters 


Meaning 

1 

2 

3 

4 

5 

6 

7 

8 
9 
0 

End  of  Line 


Input  to  the  program  consists  of  groups  of  parameter  cards  separated 
by  cards  containing  *END*  in  columns  1-5. 

The  program  will  process  a  part  of  the  input  tape  according  to  the 
values  of  a  large  number  of  parameters.  However,  the  program  contains 
default  settings  for  most  of  the  parameters  and  once  a  parameter  value  is 
set  it  continues  to  have  that  value  until  explicitly  changed.  Thus,  generally 
each  group  of  cards  need  only  contain  values  of  flight  parameters. 

Succeeding  groups  of  parameter  cards  must  specify  data  in  the  same 
order  as  it  is  contained  on  the  tape. 
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The  format  of  the  parameter  cards  is; 


C  olumn  1-6 


The  name  of  the  parameter. 

The  value  of  the  parameter  if  the  parameter  is 
floating,  integer,  or  a  time. 

The  value  of  the  parameter  if  the  parameter  is 
alpha-numeric  or  logical. 

Comments 


Column  9-18 


Column  19  -  24 


Column  25-54 


An  integer  value  may  be  expressed  either  with  a  decimal  point  or  else 
right  adjusted  to  column  18. 

A  time  parameter  must  be  expressed  as  an  integer  HHMMSS  (either 
with  a  decimal  point  or  right  adjusted  to  column  18)  in  which  the  first  two 
digits  are  the  hour,  the  next  two  the  minute,  and  the  last  two  the  second. 

A  logical  parameter  must  be  punched  as  a  "T"  or  "F"  in  column  19 
with  columns  20  -  24  blank. 

K  a  card  with  "=i<STOP’!'''  in  columns  1  -  6  is  encountered  while  reading 
parameter  cards,  the  program  terminates  immediately. 


The  following  is  an  example: 
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EXANPUt.  OF  RAWCON  CONTROL  CARDS 


PAGE  1 


$cata 

PUNCH 

radius 

6370999» 

T 

KPaR 

0  • 

R 

6339971. 

A 

6331158. 

ITPROB 

3, 

IRSCT 

chkfc 

a. 

T 

2S 

0. 

alpha 

0. 

V  6  FEB  3^967 

TAMIN 

-10. 

TAMAX 

30. 

TaVNIN 

41C. 

TaVHAX 

880* 

EKHIN 

-1C» 

ekmax 

30. 

EKVMIN 

100* 

EKVMAX 

650  * 

VXNIN 

-10. 

VXHAX 

30. 

VXVHIN 

3A0. 

VXVHAX 

820. 

PKIN 

600. 

PHAX 

1050. 

PVNIN 

115. 

PVMAX 

NISID 

970. 

CAROOl 

march  6il969 

KEY  WEST 

TSTART 

0631A0. 

MARCH  6/1969 

KEYWEST 

TSTOP 

035000. 

MISSION  1 

ZCFSl 

152. 

MARCH  6/1969 

keywest 

RNMl 

355. 

MARCH  6/1969 

KEYWEST 

RFSl 

2710. 

march  6/1969 

KEYtNEST 

RKFl 

29A.3 

MARCH  6/1969 

KEYWEST 

CPRES 

*END* 

NISID 

1. 

CAR003 

MARCH  9/1969 

TSTART 

103500. 

march  9/1969 

TST9P 

154000. 

MARCH  9/1969 

ZOFSl 

305. 

MARCH  9/1969 

RNNl 

382* 

MARCH  9/1969 

RFSi 

2511. 

march  9/ 1969 

PKPl 

296*8 

CAR003 

CPRES 

*end* 

*STOP* 

2. 

20 


The  following  is  a  table  of  all  Mission  Parameters  and  the  associated 
default  settings: 


Code 

Type 

Default 

Desc  ription 

RFSl 

R 

1871.0 

Reference  Frequency  of  Ref ractonaeter . 

RFVl 

R 

0.  0 

Reference  Voltage  of  Voltage  Ref ractometer 

RNMl 

R 

316.  0 

Reference  Refractivity. 

RKPl 

R 

285.94 

Surface  Temperature  in  °  K. 

ANDFl 

R 

0.  0 

Refractivity  of  Dry  Air  at  Surface. 

ANWFl 

R 

0.  0 

Refractivity  of  Wet  Air  at  Surface. 

AC  MR  VP 

R 

0.  0 

Height  (m)  above  which  Mix-Ratio,  Vapor 
Pressure,  and  Refractivity  will  be 
corrected. 

CORMR 

R 

0.  0 

Correction  to  Mixing  Ratio. 

CORVP 

R 

0.  0 

Correction  to  Vapor  Pressure. 

CORIN 

R 

0.  0 

Correction  to 

Refractivity. 

ITPROB 

I 

1 

Selection  of  Temperature  Probe. 

If  ITPROB  = 

1,  select  KS4  probe. 
i  2,  select  EK  probe. 

1^3,  select  Vortex  probe. 

IHUM 

I 

0 

Selection  Between  Refractometer  and 
Humidity  Processing. 

i  If  IHUM  = 

0,  process  refractometer 
input. 

1,  do  not  process  refracto¬ 
meter  but  process  humidity 
^input. 

IRSCT 

I 

1 

Selection  of  Refractometer. 

If  IRSCT  = 

l  I,  use  Refractometer  No.  1 
j  2,  use  Refractometer  No.  2 
^3,  use  Refractometer  No.  3 
L4,  use  Voltage  Refractometer 
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Code 

Type 

Default 

Description 

PUNCH 

L 

.FALSE. 

Option  for  output  through  Unit. 

.  p  „  _  .  FALSE.  ,  no  output  on  Unit  1 

.TRUE.,  no  output  on  Unit  1 

CHKFC 

L 

. TRUE. 

Option  to  check  input  line  length. 

.  TRUE.  ,  reject  lines  of  in- 
_  correct  length. 

.  FALSE.  ,  do  not  check  line 
length. 

KPAR 

I 

1 

Option  to  process  a  reading  if  a  parity  erroi 
is  found. 

0,  do  not  process  reading. 

If  KPAR  =  1,  process  readings  with 

parity  error^. 

BETAl 

R 

. 0002632 

Pi  correction  for  KS4  Temperature. 

BETA2 

R 

-0. 0002106 

P2  correction  for  EK  Temperature. 

BETA3 

R 

-0. 0000648 

Pq  correction  for  Vortex  Temperature. 

BETA4 

R 

0. 0001316 

1  ^84  correction  for  Ref ractometer . 

BETAS 

R 

0. 0000658 

05  correction  for  Ref  ractometer. 

ALPHA 

R 

-0.  75 

c^correction  for  AN. 

RADIUS 

R 

6357000. 

Radius  of  Earth. 

R 

R 

6354120. 

Length  of  Semi-Minor  Axis. 

A 

R 

6356363. 

Length  of  Semi-Major  Axis. 

PROCS 

L 

.  TRUE. 

Selection  to  Process  Data 

If  PROCS  -  ■  '  then  process  data 

.FALSE.,  do  not  process. 

DUMP 

L 

.FALSE. 

Selection  to  dump  tape  input. 

Tf  DTTMP  -  *  "^^UE.  ,  dump  aircraft  input 

.  FALSE.  ,  do  not  dump. 

ZS 

R 

535. 4117 

Height  of  surface  above  Sea  Level. 

1.  If  readings  with  parity  errors  are  processed,  then  on  the  printed  output 
the  reading  number  is  followed  by 
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The  following  parameters  establish  the  linear  conversion  functions 
for  Speed,  Pressure,  and  Temperature  input  (tape). 


Code 

Type 

Default 

Description 

PVMIN 

R 

18, 

Minimum  voltage  of  pressure  probe  (mv). 

PVMAX 

R 

1017. 

Maximum  voltage  of  pressure  probe  (mv). 

PMIN 

R 

600. 

Pressure  corresponding  to  PVMIN  (mb). 

PMAX 

R 

1060. 

Pressure  corresponding  to  PVMAX  (mb). 

SVMIN 

R 

691. 

Minimum  voltage  of  Air  Speed  probe  (mv). 

SVMAX 

R 

1060. 

Maximum  voltage  of  Air  Speed  probe  (mv). 

SMIN 

R 

135. 

Air  Speed  corresponding  to  SVMIN  (knots). 

SMAX 

R 

195. 

Air  Speed  corresponding  to  SVMAX  (knots). 

T4VMIN 

R 

190. 

Minimum  voltage  of  KS4  temperature  probe. 

T4VMAX 

R 

891. 

Maximum  voltage  of  KS4  temperature  probe 

T4MIN 

R 

-40. 

Temperature  corresponding  to  T4VMIN. 

T4MAX 

R 

35.9 

Temperature  corresponding  to  T4VMAX. 

EKVMIN 

R 

278. 

Minimum  voltage  of  EK  temperature  probe. 

EKVMAX 

R 

769. 

Maximum  voltage  of  EK  temperature  probe. 

EKMIN 

R 

-40. 

Temperature  corresponding  to  EKVMIN. 

EKMAX 

R 

35.  9 

Temperature  corresponding  to  EKVMAX. 

VXVMIN 

R 

241. 

Minimum  voltage  of  Vortex  Temperature 
probe. 

VXVMAX 

R 

1050. 

Maximum  voltage  of  Vortex  temperature 
probe. 

VXMIN 

R 

-40. 

Temperature  corresponding  to  VXVMIN. 

VXMAX 

R 

32. 

Temperature  corresponding  to  VXVMAX. 
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The  following  flight  parameters  are  those  likely  to  change  with  each 
request. 


Code 

Type 

Default 

-  Description 

MISID 

A 

None 

Mission  ID. 

TSTART 

T 

0. 

Flight  Start  Time. 

TSTOP 

T 

235959. 

Flight  Stop  Time. 

CPRES 

R 

0. 

Pressure  Correction. 

CSPEED 

R 

0. 

Speed  Correction. 

CKS4T 

R 

0. 

KS4  Temperature  Correction. 

CEKT 

R 

0. 

EK  Temperature  Correction. 

CVXT 

R 

0. 

Vortex  Temperature  Correction. 

ZC^FSl 

R 

914. 

Beginning  Height. 

In  addition  to  these  parameters  the  tape  to  be  processed  must  be 
specified.  This  is  done  through  various  variables  placed  in  labeled  commons. 

The  following  is  a  list  of  the  tape -de scription  parameters: 


Common 

Variable 

Desc  ription 

ZTPDNN 

NMISS 

Number  of  Missions  on  the  Tape. 

ZTPDNN 

NAMES  (I) 

Name  (Number)  of  the  ith  Physical  Mission. 

ZTPDNT 

NTMPER  (I) 

Number  of  Time  Periods  in  ith  Mission.  (New 
time  period,  if  off-the-air  for  more  than  one 
hour.  ) 

ZTPDHL 

ISPEC  (1,1) 
ISPEC  (2,r) 

Start  Hour  for  ith  Time  Period  (0-24). 

Stop  Hour  for  ith  Time  Period. 

ZTPDMP 

MAPT  (J) 

The  Position  Number  of  the  jth  Input  Parameter 
of  a  ’'Reading"  where  Time  is  input  parameter 
No.  1,  Refractometer  1  is  input  parameter  No. 
2,  etc.  The  standard  input  sequence  is  the 
same  as  listed  in  section  2-2. 

ZNFPL 

NFPL, 

Number  of  parameters  in  a  reading. 
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Every  airborne  ’’reading"  consists  of  a  maximum  of  13  parameters. 
Due  to  frequent  changes  in  the  equipment  configuration,  these  parameters 
may  appear  in  a  sequence  other  than  the  standard  format.  MAPT  (j)  allows 
the  arbitrary  ordering  of  input  parameters  on  the  mission  tape,  since  it 
provides  a  mapping  to  the  standard  sequence. 

4.  4  Secondary  Output 

If  parameter  PUNCH  is  true,  certain  variables  are  output  to 
FORTRAN  Unit  1.  There  is  one  record  for  each  "reading,  ’’  and  at  the  end 
of  each  flight  a  tape  mark  is  written. 

The  record  has  the  following  format: 

Column  1  -  6  Count  which  appears  on  listing. 


C  olumn  7 

-  13 

Height  (in  meters). 

Column  14 

-  20 

Refractivity  (N  units). 

Column  21 

-  27 

Refractivity  (M  units). 

Column  28 

-  34 

Temperature  (°  C). 

Column  35 

-  41 

Potential  Temperature  (°  C)' 

Column  42 

-  48 

Water  Vapor  Pressure  (mb). 

Colunon  49 

-  55 

Air  Pressure  (mb). 

Column  56 

-  62 

Mixing  Ratio  (g/Kg). 

4.  5  Restriction  on  Indirect  Method  for  the  Computation  of  Refractivity-!- 

RAWCON  provides  two  methods  for  the  computation  of  refractivity. 
The  "direct  method"  obtains  the  value  of  the  refractivity  directly  from  a  re- 
fractometer,  while  the  "indirect  method"  arrives  at  the  result  from  various 
atmospheric  parameters  such  as  temperature,  pressure  and  humidity. 

The  formula  used  in  this  case  is  again 
N  =  77.6  ^  +3.73  10®;^ 

where  e  must  be  obtained  through  the  mixing  ratio  and  a  vapor  pressure 
table  (EH20). 
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Since  the  currently  used  humidity  probe  is  functioning  in  an  unreliable 
fashion,  the  humidity  input  has  been  set  to  a  constant  100%.  Thus,  any  re- 
fractivity  results  obtained  by  the  "indirect  method"  are  based  on  a  humidity 
parameter  of  100%.  If,  at  any  future  time,  it  is  desired  to  use  the  actual 
observed  value  for  humidity,  a  minor  modification  must  be  made  to  the  sub¬ 
routine  "WET.  " 


4.  6  Structure  of  RAWCON* 


RAWCON  is  a  collection  of  individual  subroutines,  with  each  sub¬ 
routine  serving  an  integral  function.  This  collection  of  subprograms  separates 
into  two  categories: 


1.  Reading  and  pre-processing  of  input. 

2.  Computation  and  output. 

4.  6.  1  Input-Oriented  Subroutines 


INPUT 


KHAR 

PINTl 

RDLINE 


This  routine  controls  "line"  input.  By  a  "line"  of  in¬ 
put  we  mean  one  complete  set  of  instantaneous  atmo¬ 
spheric  readings  consisting  of  time,  temperature, 
pressure,  . 

This  routine  reads  and  interprets  characters. 

This  routine  is  the  mission  parameter  card  interpreter. 
This  routine  reads  a  "line"  of  data. 


4.6.2  Computation-Oriented  Subroutines 


REFCOL 

PAT 

WET 

REFCT 

HEIGHT 


This  subroutine  controls  all  computation-oriented 
routines  and  produces  the  output. 

Routine  to  compute  pressure,  air-speed,  and  temperature. 

This  routine  computes  ref ractivity,  vapor-pressure  and 
mixing  ratio  by  the  indirect  method. 

This  routine  computes  refractivity,  vapor-pressure 
and  mixing  ratio  by  the  direct  method. 

This  routine  performs  the  geopotential  height  computa¬ 
tions  . 
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The  only  linkage  between  the  input-ori'ented  routines  and  the  com¬ 
putational  routines  is  in  the  driver-program  AIDA  with  a  call  to  RAWCON 
The  only  data  link  between  the  two  categories  is  a  labelled  COMMON  with 
the  name  /INPT/. 
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SECTION  V 


PLOT 


This  program  processes  meteorological  data  and  produces  a  plotting 
tape  for  the  Stromberg-Carlson  4020.  The  source  of  the  meteorological 
data  is  either  a  tape  produced  by  RAWCON  or  a  tape  containing  radiosonde 
data  produced  by  RSONDE.  Card  input  is  also  used  to  control  what  data  is 
plotted. 

For  each  set  of  readings  specified  by  control  cards  two  frames  are 
produced.  The  first  frame  contains  refractivity.  Two  lines  are  plotted,  one 
in  N  units  and  one  in  M  units.  The  second  frame  contains  three  lines 
1)  Temperature  (labeled  T);  2)  Potential  Temperature  (labeled  9);  3)  Vapor 
Pressure  (labeled  E).  All  these  parameters  are  plotted  horizontally  with 
the  vertical  axis  being  height  with  limits  of  Om.  and  4000  m. 

5.  1  Operational  Procedure  Under  IBSYS 

The  tape  to  be  processed  must  be  ’’set  up”  as  FORTRAN  logic  unit  1. 
There  are  two  routines  named  ”INPUT”  in  the  deck.  One  is  used  for  plotting 
RAWCON  tapes,  the  other  is  used  for  plotting  QUACK  tapes.  The  sub¬ 
routine  for  plotting  RAWCON  data  has  a  deckname  of  ”XINPUT”,  the  one  for 
the  CUACK  data  has  a  deckname  of  ”XINRAD”.  Either  one  of  these  must  be 
removed  or  a  $USE  IBJOB  control  card  may  be  used.  The  format  of  this 
card  is  either 
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1 


$USE 

$USE 


XINPUT  (INPUT) 
XINRAD  (INPUT) 


The  first  is  used  for  RAWCON  data,  the  second  for  RSONDE  data. 

5.  2  Plotting  RAWCON  Data 

The  output  tape  from  RAWCON  consists  of  a  file  for  each  set  of  para¬ 
meters  processed.  Card  input  to  PLOT  consists  of  one  card  for  each  set  of 
data  to  be  plotted.  The  format  of  the  card  is: 
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C  olumn 


Contents 


1  -  4 

5  -  6 

9  -  13 
14  -  18 
20  -  49 


FILE 

Number  of  the  file  (must  be  between  1  and  20  with  a 
leading  0  if  it  is  less  than  10). 

First  reading  to  be  plotted  (right  adjusted  number). 
Last  reading  to  be  plotted  (right  adjusted  number). 
Any  characters;  it  is  used  as  a  title 


The  "reading”  numbers  referred  to  are  the  numbers  printed  in  the 
column  headed  "READINGS"  by  RAWCON. 


Successive  cards  must  be  increasing,  i.e.,  either  specify  a  higher 
file  number  or  have  a  first  reading  number  greater  than  the  last  reading  on 
the  previous  card. 

Processing  is  terminated  by  a  card  with  >l<STOP'J^  in  columns  1-6. 

5.  3  Plotting  QUACK  Data 


The  output  tape  from  QUACK  is  mounted  on  FORTRAN  Unit  1.  The 
program  selects  only  certain  stations  and  days  for  plotting.  These  are 
specified  by  input  cards. 

The  stations  are  specified  on  a  group  of  cards  with  the  following 
format:  12  fields  of  6  characters  each.  The  first  field  contains  the  number 
of  stations,  succeeding  fields  contain  the  station  numbers.  All  fields  are 
right  adjusted,  blank  filled.  As  many  cards  as  required  are  read. 

The  days  to  be  plotted  are  specified  in  a  manner  similar  to  the  above. 
The  first  field  contains  the  number  of  days  and  the  succeeding  fields  contain 
the  day  numbers. 

Plot  F ormat 


The  plot  format  is  controlled  by  various  labeled  commons.  There  are 
two  BLOCK  DATA  programs  included  in  the  current  deck  to  initialize  these 
parameters.  XBLK  produces  two  frames  for  each  profile,  each  frame  being 
approximately  6"  x  8".  SMLBLK  provides  alternate  values  for  some  of  the 
parameters  which  result  in  one  frame  for  each  profile  with  two  plots  on  the 
frame,  each  plot  approximately  3"  x  4". 
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SECTION  VI 
TRACE 


TRACE  is  a  ’’ray  tracing’*  program.  It  can  be  used  to  follow  the  propa¬ 
gation  of  radio  waves  through  a  changing  atmosphere.  The  calculations  are 
based  on  Snell's  law  and  do  not  take  into  account  diffraction,  scattering,  or 
inte  rfe  rence . 

Input  to  the  program  consists  of  atmospheric  profiles,  and  control 
cards.  The  program  will  accept  multiple  profiles  and  interpolate  between 
them.  All  profiles  must  be  in  the  path  of  the  ray  being  traced;  no  cross -path 
interpolation  is  performed.  The  on-path  interpolation  is  not  linear  and  the 
user  (see  ^'PROF  card)  has  considerable  influence  over  how  it  is  done. 

The  control  cards  allow  the  user  to  trace  groups  of  rays  at  various 
heights,  ranges,  and  elevation  angles.  A  ray  is  always  reflected  from  the 
surface  and  the  user  may  specify  reflection  from  an  elevated  ’’level”  as  well. 

Both  printed  output  and  a  plotting  tape  (for  a  Stromberg -Carls on  4020) 
can  be  produced  by  the  program.  Printed  output  consists  of  a  summary  of 
control  information,  and  (as  an  option)  detailed  descriptions  of  each  ray’s  path. 

6.  1  Input  Format 

All  control  cards  have  the  following  format: 

Column  1 

Column  2-10  Function 

Column  11-80  Seven  parameters  in  fields  of  10  columns. 

Parameter  1  in  Column  11  -  20. 

Parameter  2  in  Column  21  -  30,  etc. 

’’Function”  is  an  alphabetic  code  to  tell  what  kind  of  card  this  is.  The 
parameters  are  numeric.  They  may  appear  anywhere  in  the  appropriate  field 
but  a  decimal  point  must  be  present,  even  for  integer  values  (e.  g,  ,  RAY- 
COUNT).  Not  all  functions  use  all  parameters.  There  are  two  other  types 
of  cards,  the  cards  which  describe  the  atmosphere  (see  ^PKOF  card)  and 
the  title  card  (see  *TRACE  card).  The  following  conventions  hold  for  the 
units  on  control  cards:  Height  is  always  expressed  in  meters,  range  in  kilo¬ 
meters  and  elevation  in  radians.  However,  when  the  program  prints  a  range 
without  indicating  the  units,  it  is  in  meters. 
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Many  control  cards  turn  "options”  on  or  off.  All  options  are  off  at  the 
start  of  processing  and  are  only  changed  by  control  cards. 

6.  2  Control  Cards 

SPRINT 

Parameters:  None 

Function:  Turns  on  the  printing  option. 

When  this  option  is  on,  detailed  descriptions  of  the  path  of  each  ray 
are  printed. 


^•^NOPRINT 

Parameters:  None 

Function:  Turns  off  the  printing  option. 

When  this  option  is  off  only  summaries  are  printed  for  each  ray. 


>:<STOP 

Parameters:  None 

Function:  Terminates  processing. 


^J^PATH 

Parameters:  None 

Function:  Resets  the  program  and  prepares  it  to  accept  profiles 

for  a  new  path. 

It  must  appear  before  any  *PROF  cards. 


>:<PROF 


Parameters;  RANGE 

Function:  Marks  the  beginning  of  a  profile. 

The  cards  immediately  following  it  describe  the  atmosphere  at  the 
indicated  RANGE.  The  range  must  be  larger  than  the  range  of  any 
previous  profiles  in  the  same  path,  (i.e.,  between  ^'PATH  cards  the 
ranges  must  increase).  When  the  program  encounters  this  card  it 
reads  profile  description  cards  until  a  *PEND  card  is  read.  A  pro¬ 
file  description  card  has  the  following  format: 
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Column  1-6  Either  blank  or  contains  ’’*LEVEL'' 

Column  11-20  Height 

Column  21  -  30  Refractivity  in  N  units  at  that  height. 

Within  a  profile  the  heights  on  successive  profile  cards  must  be  in¬ 
creasing,  except  that  successive  cards  with  identical  height  and  refractivity 
are  allowed.  (This  allows  two  levels  to  appear  at  the  same  height,  )  The 
profiles  of  any  path  may  have  varying  numbers  of  profile  description  cards 
but  must  all  have  the  same  number  of  *LEVEL  cards. 

The  *LEVEL  cards  are  used  to  describe  the  interpolation.  Basically, 
the  program  divides  the  atmosphere  into  blocks  bounded  in  range  by  the  range 
of  the  various  profiles  and  in  height  by  lines  connecting  corresponding  levels. 
See  the  section  on  interpolation  for  a  more  detailed  description. 

The  program  always  constructs  a  level  for  the  first  and  last  height  of 
a  profile;  if  these  heights  are  specified  with  *LEVEL  cards,  there  will  be 
multiple  levels  at  these  heights.  This  situation  will  be  properly  treated  by 
the  program. 

>!^PEND 


Function:  Terminates  the  reading  of  profile  description  cards. 

*TRACE 

Parameters:  START-RANGE,  START -HEIGHT,  START -ELEVATION, 
STOP-RANGE,  RAY-COUNT,  BUMP -VARIABLE, 
DELTA 

Function:  Initiate  tracing  of  rays. 

The  number  of  rays  which  this  card  causes  to  be  traced  is  given  by 
RAY -COUNT.  (If  RAY-COUNT  is  0,  one  ray  is  traced.  )  The  first 
ray  has  a  start  height,  range  and  elevation  as  given  by  the  first  three 
parameters.  The  start  conditions  of  the  other  rays  are  determined 
by  BUMP -VARIABLE  and  DELTA.  For  each  succeeding  ray,  DELTA 
is  added  to  the  start  range,  height,  or  elevation  depending  on  whether 
BUMP -VARIABLE  is  1,  2,  or  3,  respectively.  Tracing  continues 
with  reflections  from  the  surface  (if  the  surface  is  included  in  the  in¬ 
put  profiles).  A  ray  is  stopped  when  its  range  exceeds  STOP -RANGE 
or  its  height  leaves  the  range  in  which  the  atmosphere  is  specified. 

The  card  immediately  following  the  >«<TRACE  card  is  a  title  card. 
Columns  1  -  30  of  the  title  card  are  used  as  a  title  in  various  places 
of  the  output. 
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*PLOT 


Parameters:  START-RANGE,  FRAME-RANGE,  BOTTOM-HEIGHT, 
TOP-HEIGHT,  DENSITY,  GRID 

Function:  Turns  on  the  plotting  option. 

No  plotting  occurs  when  it  is  read.  Rather,  when  a  ^5^TRACE  card  is 
processed  all  rays  traced  will  be  plotted  together.  Rays  from  multiple 
*TRACE  cards  may  be  plotted  together  using  ^J^HOLD  and  ^ENDHOLD 
cards.  The  parameters  establish  the  scale  and  grid  for  the  plots.  If 
they  are  omitted,  reasonable  values  are  used.  More  than  one  frame 
may  be  used  to  plot  a  set  of  rays  if  the  range  of  the  rays  require  it. 
FRAME -RANGE  is  the  range  (in  Km)  covered  by  each  frame.  Rays 
are  plotted  only  when  their  height  is  greater  than  BOTTOM-HEIGHT, 
and  less  than  TOP -HEIGHT,  and  their  range  is  greater  than  START - 
RANGE.  GRID  determines  how  tall  the  plots  are.  It  must  be  between 
0  and  950.  The  plots  are  taller  when  it  is  larger.  DENSITY  indirectly 
determines  the  number  of  grid  lines.  It  must  be  between  8  and  GRID. 
There  are  fewer  grid  lines  when  it  is  larger. 


>l<NOPLOT 

Parameters:  None 

Function:  Turns  off  the  plotting  option. 


^:<DELHT 

Parameters:  HEIGHT -INCREMENT 

Function:  Specifies  a  maximum  height  difference  between  suc¬ 

ceeding  points  in  the  trace. 

(Under  various  circumstances  the  difference  will  be  less  than  HEIGHT- 
INCREMENT,  but  it  will  never  be  more.  )  This  value  holds  for  all 
succeeding  traces  until  another  ^DELHT  card  is  encountered.  Before 
a  ^'^DELHT  card  is  encountered  the  maximum  difference  is  20  meters. 
For  a  detailed  description  of  how  the  next  point  is  chosen  in  the 
iteration  see  the  section  "Step  Size.  " 


REFLECT 

Parameters:  LEVEL,  STOP -ATTENUATION,  FREQ 
Function:  Turns  on  the  reflection  option. 
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Rays  will  be  reflected  from  the  level  numbered  LEVEL.  (Note: 

Since  the  program  automatically  adds  a  level  at  the  first  input  height 

the  number  of  the  first  *LEVEL  card  is  level  2.  )  At  reflection,  from 
the  surface  or  the  level,  an  attenuation  is  computed.  VTien  the 
strength  of  the  ray  falls  below  STOP -ATTENUATION  tracing  for  that 
ray  stops  (STOP -ATTENUATION  is  given  in  dB.  It  may  be  given  as 
positive  or  negative.  Its  absolute  value  is  used.  ).  FREQ  is  the 
frequency  in  MHz  to  be  used  in  computing  the  attenuation.  If  either 
STOP -ATTENUATION  or  FREQ  is  omitted  reasonable  values  are  used. 

WOREFLECT 

Parameters:  None 

Function:  Turns  off  the  reflection  option. 


*HOLD 

Parameters:  None 

Function:  Delimits  start  of  rays  to  be  collected. 

Normally  the  rays  of  a  single  *TRACE  card  are  plotted  together. 
When  a  *HOLD  card  is  encountered  the  plotting  is  suspended  but  all 
rays  are  accumulated. 


*HOLDEND 

Parameters:  None 

Function:  Delimits  end  of  rays  to  be  collected. 

When  this  card  is  read  all  the  rays  which  have  been  traced  since  the 
last  *HOLD  card  are  plotted  together. 

6.  3  Interpolation 

The  interpolation  algorithm  was  motivated  by  the  following  considera¬ 
tion:  The  atmosphere  must  be  modeled  in  a  manner  which  allows  perturba¬ 
tions,  such  as  a  layer,  to  move  up  and  down  while  the  basic  profile  remains 
the  same.  As  part  of  the  input  profile  the  user  specifies  heights  which  are 
to  be  used  as  levels.  The  program  constructs  blocks  of  the  atmosphere 
bounded  by  the  ranges  of  the  profiles  and  lines  connecting  corresponding  levels. 
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To  determine  the  refractivity  of  an  arbitrary  point  (H,  r)  the  process 
is  as  follows: 

1.  Determine  the  block  in  which  the  point  lies. 

h  hK 

2.  Calculate  its  ’’relative  height”  within  the  block  hj-  =  7 — 

^t  "  % 

where  h^,  h^  are  the  heights  of  the  top  and  bottom  of  the  blocks 
respectively,  at  range  r. 

3.  Determine,  at  the  ranges  bounding  the  block,  the  refractivity 
at  relative  height,  h^..  These  heights  are  labeled  h^  and  hg  in 
the  diagram.  This  is  done  by  linear  interpolation  between 
points  on  the  input  profiles. 

4.  The  refractivity  is  calculated  by  a  linear  interpolation  along 
the  line  of  relative  height  hj.,  (i.e.  ,  the  line  connecting  hx 
and  hg). 
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6.  4  Step  Size 


The  formulas  used  for  each  step  of  the  ray  are  based  on  an  integral 
over  height.  If  the  current  height  is  h,  the  next  height  is  determined  in  the 
following  procedure. 

1.  Add  to  h  either  +DELHT  or  -DELHT  depending  on  whether  the 
ray  is  going  up  or  down.  Set  h^  to  this  height. 

2.  On  the  last  iteration  the  "limits  of  linearity"  were  determined 
as  a  by-product  of  the  calculation  of  refractivity.  These 
limits  are  the  heights,  at  the  last  range,  between  which  the 
interpolation  model  (as  described  in  Section  6.  3)  gives  a 
linear  atmosphere.  If  either  of  these  heights  is  between  h 
and  h^,  set  h^  to  it. 

3.  If  the  difference  between  h  and  h^  is  less  than  one  meter,  make 
it  one  meter. 

4.  If  the  ray  path  has  a  turning  point  between  h  and  h^,  set  h^  to 
the  height  at  which  the  elevation  is  0  and  change  the  direction 
of  the  ray.  The  final  value  of  h^  is  the  next  height. 

6.  5  Equations 

The  formulas  used  in  the  iterative  process  are  due  to  Colin  Gardner. 
Their  derivation,  as  summarized  here,  is  contained  in  Pacific  Missile  Range, 
Technical  Note  3280-6,  "Determination  of  Elevation  and  Slant  Range  Errors 
due  to  Atmospheric  Refraction.  " 

The  following  is  a  summary  of  the  derivations. 

Notation. 

B  is  the  elevation  angle. 

0  is  the  earth  central  angle. 

H  is  height. 

N  is  refractive  index. 

We  assume  Snell's  law  for  a  spherical  earth. 
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Then 


No  (1  +  — )  cosBo  =  n(l+  —  )cosB=k 
r  r 


dH 


MQ  cot  BdH  .  H  /  2  .  H,3  .2 

d0  =  — — —  = - — —  =  (1+  —  Vn  (1+—)  -  k 

r+H  r+H  r  r 


dN 


assuming  that  =  a  is  constant 


ndH  =  [ 


n 


T  rk  sin  B  _ 
]  :  ■  -  dB 


a  (r  +  H)  +  n  cos  B 


Thus 


d0  = 


n 


rk  sin  B 

dB 


a  (r  +  H)  +  n  cos  B 


or 


^r+i 

A6  =  J 


n 


B- 


a  ( r  +  H )  rn 


dB 


now 


— ; - — -  does  not  vary  much  with  height  and  we  may  take 

a(r+H)+n  ^  ^  ’ 


_  _ IT _  _ n  AB _ 

^  a  (r  +  H)  +  n  ~  An  (r  +  H)  +  n  AB 


which  is  the  formula  used  by  TRACE, 
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APPENDIX  I 

COMPUTER  PROGRAM  LISTINGS 
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This  Appendix  contains  listings  of  all  the  programs  described  in 
this  report.  They  do  not  include  the  assembly  language  plotting  routines. 
These  are  the  standard  routines  written  by  North  American  Aviation,  and 
available  from  Stromberg-Carlson. 

In  order  to  accommodate  the  method  of  reproduction  some  cards  in 
these  programs  are  split  into  two  lines.  It  is  always  obvious  when  this  has 
been  done. 
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A7095 


REFCoin 


_1 


BROAD  FLOW  CHART  OF  RAWCON 
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A7096 


PLINIT 


OVERALL  PROGRAM  LOGIC  OF  TRACE 
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A7097 


GET  NEXT 
HEIGHT 

•  \ 

USE  SLOWER  BUT 
EQUIVALENT 
EQUATION  FOR 
NEW  RANGE 

SUBROUTINE  BUMP  IN  TRACE 
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PAPTQMAG 


PAGE  1 


A  JOB  t 

arewind  bo. 

AMETAB920  SI/B0/L0iC8NC#SET. 

EXTEND 

•  R6RG  0200 

CHARL  EQU  36*254/8 

SPACELIM  EQU  8 

BRU  ENDPT  FOR  OPERATOR  TO  BRU  TO. 

BEGIN  RES  0 

CLA 

STA  RECCNT 

BRN  QUEST 

PZE  POSMES 

BRU  STRTPT 


* 

* 


* 

* 


THIS  POSITIONING  EFFORT  IS  DIRECTED. 

TOWARD  FINDING  A  TRIPLE  EOF.  AND 

POSITIONING  THE  TAPE 
BETWEEN  THE  SECOND  AND  THIRD  EOFS. 

IT  IS  NORE  ELABORATE  THAN  SEEMS  NECCESSARY 
PRPBLEMS  WITH  the  TAPE  UNITS. 


SKIPFILE 

BRM 

TAPEWAIT 

SFl 

8RM 

TESTFWD 

BRU 

T+2 

BRU 

SFl 

NOT 

AN  EOF. 

BRM 

TESTFWD 

BRU 

$+2 

2ND 

EOF. 

BRU 

SFl 

BRM 

TESTFWD 

BRU 

i+2 

3RD 

EOF. 

BRU 

SFl 

SF2 

BRM 

TESTBCK 

BRU 

SF2 

SF3 

BRM 

TESTFWD 

BRU 

*  +  2 

BRU 

SF3 

BRM 

TESTFWD 

BRU 

STRTPT  ' 

DIR 

HLT 

STRTPT 

RES 

.0 

START  THE  PAPER  TAPE 

LDA 

pBUF 

SET  UP  FOR  START  OF 

STA 

PTR 

LDA 

=CHARL//3-l 

STA 

CHARCT 

LDX 

s  I!”3 

STB 

SPACES 

CLA 

4'4 


PAPT8MAG 


PAGE  a 


CAT 


BRU 

4-1 

EOM 

oeaoA 

winldr 

WIM 

INPT 

LOA 

INPT 

ETR 

=  0377 

SKE 

=  0 

BRU 

WIM+1 

BRU 

WIMLDR 

STRTRFC 

LDA 

»BUF 

STA 

PTR 

LDA 

=charl//3-i 

STA 

CAT 

CHARCT 

BRU 

4-1 

ESM 

C6304 

STRTWD 

LDX 

s  -3 

W  IH 

WIM 

INPT 

LDA 

INPT 

ETR 

=  3377 

LDB 

s-SPACELIM 

SKE 

=  0 

STB 

SPACES 

MIN 

SPACES 

SKN 

SPACES 

bKU 

clb 

ENDPT 

ASSEM 

EXu 

LSH,a 

EXU 

MRQNOP^a 

STA 

^‘PTR 

BRX 

WIM 

MIN 

PTR 

SKR 

CHARCT 

BRu 

STRTWD 

DSC 

WTPB1(\ 

BETP 

LDA 

DRM 

BRU 


SET  A  WORD 

WHICH  MINGT  BE  LEADER. 

GEY  BYTE 

G6  CQNTINUE- 

SET  UP  START  OF  RECORD 
PTR  TB 

NEXT  W3RD  IN  9UTPUT  BUFFER. 
CHARACTER  C8UNTER. 


3  S"BIT 

characters  to  a  word. 

GET  NEXT  CHARACTER, 


TEST  FOR  blank  TAPE, 
aUHP  COUNT, 


align  character  properly 
merge  cND  ,aND  3RD  CHARS, 


GO  GET  NEX  CHARACTER, 
WORD  IS  COMPLETE  BUMP  IT 
CHECK  CHAR  COUNT, 

MORE  TO  GO. 

WRITE  OUT  RECORD  NOW, 

1/BUF/ A*(CHARL//3) 

ENDMT 

-CHARL//3-1 

PUTREC 

STRTREC 


«  ROLL  OF  TAPE  IS  FINISHED,  SEE  WHAT  TO  DO  N£XT. 

ENDPT  DSC 

LDA  =CHARL//3 
sub  CHARCT 

STA  CHARCT 


PAPTOMAG 


PAGE  3 


■K 

endmt 


lstms 


PUTREC 


PUTL 


wtpbin 

1/BUFi ( 

BETP 

ENDMT 

IDA 

CHARCT 

SUB 

=  1 

BRM 

PUTREC 

wtmark 

1 

BRM 

QUEST 

PZE 

EOMMES 

BRU 

STRTPT 

wtmark 

1 

BRH 

QUEST 

PZE 

EOTMES 

BRU 

STRTPT 

wtmark 

4 

i 

REWIND 

1 

BRM 

GUEST 

PZE 

TAPMES 

BRU 

begin 

8RU 

1 

BACKSPACE  1/(2) 

rtpbin 

1/BUF 

btmk 

LSTMS 

BRU 

ENDMT 

wtmark 

1 

REWIND 

1 

TYPE 

REWMES 

TYPE 

REIMES 

BRU 

BEGIN 

PAGE 

PZE 

MIN 

RECCNT 

BPT 

2 

BRR 

PUTREC 

STA 

WORDCNT 

BLANK 

LINE/33 

MOVE 

RECMES/ 

BINBCD 

LINE/9/ 

PRINT 

LINE/ ' J 

lda 

=  BUF 

STA 

PTR 

LDA 

*-l 

STA 

NEWLINE 

LDX 

s-3 

AND  WRITE  THAT  MANY. 


find  but 

IP  THERE  ARE  MORE  RBLLSIN 
THIS  MISSION* 

MORE  ROUES. 

ONE  EOF  IS  EN0UG. 


ARE  THERE  MORE  MISSIONS. 
YES 


ARE  there  more  MAG  TAPES. 
YES. 


READ  A  record 
IF  THIS 

IS  END  OF  MS  I  SI  ON  BRU 
QTHW  CONTINUE 
BACK  SPACEING. 

PUT  ON  A  3RD  EOF 


AND  start  over. 

OUTPUT  A  record. 
BUMP  RECORD  COUNT 


'LINE/2^6 

'RECCNT 


PRINT  header. 


START  AT 

BEGINNING  OF  BUFFER 
FORCE  NEW  line. 
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PUTCNV 


shift 


PAPT0MAG 

PAGE 

LDA 

*PTR 

EXU 

RSH/  2 

ETR 

=  0377 

BRM 

PUTCNV 

BRX 

PUTL+1 

MIN 

PTR 

BUMP  POINTER  IN  BUFFER* 

SKR 

WSRDCNT 

BUMP  C8UNT. 

BRU 

PUTL 

KEEP  G0ING. 

SKN 

NEWLINE 

STARTING  A  NEW  LINE, 

BRU 

T+a 

N8* 

BRR 

PUTREC 

YES.  RETURN. 

PRINT 

LINE 

BRR 

PUTREC 

PZE 

convert  a  character 

STA 

TEMPI 

SAVE  WORD 

SKN 

NEWLINE 

SHOULD 

WE  START  A  NEW  LINE. 

BRU 

SHIFT 

NO, 

BOA 

=  LINE 

YES  RESET  PTR. 

STA 

LINEPTR 

niN 

NEWLINE 

RESET  INDICATOR, 

STX 

TEMP2 

Blank 

LlNE/33 

LDX 

TEMP2 

RES 

0 

LDA 

TEMPI 

ETR 

=»07 

STA 

^^LINEPTR 

LEAST  significant 

octal  digit. 

LDA 

TEMPI 

LSH 

3 

ETR 

=0700  ' 

NEXT  octal  DIIT 

MR6 

♦LINEPTR 

STA 

♦LINEPTR 

LDA 

TEMPI 

LSH 

6 

ETR 

=070000 

LAST  DIGIT. 

MRG 

♦LINEPTR 

MRG 

-!  000' 

STA 

♦LINEPTR 

fine  for  m  of  word. 

NIN 

LINEPTR 

BUMP  PTR. 

LDA 

LINEPTR 

SKG 

=LINE+29 

END  OF  LINE. 

6RR 

PUTCNV 

NO, 

PRINT 

LINE 

YES. 

SKR 

NEWLINE 

BRU 

IN  CASE  OF  ERROR. 

BRR 

PUTCNV 
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QUEST 

page 

PZE 

LOA 

GUEST 

etr 

*037777 

ADO 

?04000l 

STA 

QUEST 

TYPE 

♦QUEST 

INQ 

TYPEIN 

BUF 

LDA 

BUF 

SKE 

s  1  Y  » 

6RU 

$  +  2 

BRR 

QUEST 

SKE 

s  »N  ^ 

ORU 

INQNG 

MIN 

GUEST 

BRR 

QUEST 

INGNG 

TYPE 

NGMES 

BRU 

INQ 

testfwd 

PZE 

CAT 

BRU 

^-1 

SKN 

DIR 

BRU 

31  +  2 

BRM 

TAPEWAIT 

SFB 

0/1/4 

WIM 

BUF 

DSC 

CLA 

STA 

DIR 

TFT 

BRR 

TESTFWD 

MIN 

TESTFWD 

BRR 

TESTFWD 

TESTDCK 

PZE 

CAT 

BRU 

$-1 

SKN 

DIR 

BRM 

TAPEWAIT 

SRB 

0/1/4 

WIM 

BUF 

DSC 

LDA 

s-1 

STA 

DIR 

TFT 

BRR 

T+STBCK 

MIN 

TESTBCK 

BRR 

TESTBCK 
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ASK  OUESTieNS. 

EXTRACT  A0DR» 
TURN  dN 

INDR  bit  and  bump. 


GET  RESPBNES. 

YES  RESPeNE 
N8. 

YES  RETURN. 

NO  RESP0NE. 

NO.  TRY  AGAIN, 

TAKE  NEGATIVE  EXIT. 


WAIT  FOR  CHANNEL 

IF  TAPE  IS  GOING  FORWARD 
DONT  HAVE  TO 
WAIT  FOR  IT  TO  COME  RDY 
OTHW.  WAIT 


INDICATE  GOING  FORWARD 

EOF 

NO, 


CHECKDIRECTI0N 
GOING  FORWARD. 

INDICATE  GOING  BACKWARD 
TEST  FOR  EOF, 

NO, 


48 


paptsmag 


TAPEWAIT 

PZE 

IRT 

0/  1 

BRR 

TAPEWAIT 

BRU 

$“S 

RSH 

16 

RSH 

8 

RSH 

NOP 

EQU 

$ 

LSH 

16 

LSH 

.8 

LSW 

NOP 

EQU 

$ 

NOP 

MRG 

*PTR 

MRG 

^tPTR 

MRGNOP 

EQU 

$ 

eommes 

TEXT 

<ARE  THEi 

EOtMES 

text 

<ARE  THE! 

RECMES 

TEXT 

<REC0RO> 

tapmes 

TEXT 

<ARE  THE! 

POSMES 

TEXT 

<IS  THIS 

rewmes 

TEXT 

<END  OF 

RElMES 

TEXT 

<CURRENT 

NGMES 

TEXT 

<LEGAL  R 

LINE 

RES 

33 

TEMPI 

PZE 

TEMPa 

PZE 

DIR 

PZE 

WSRDCNT 

PZE 

' 

RECCNT 

DATA 

0/0 

NEWLINE 

PZE 

LINEPTR 

PZE 

chaRct 

PZE 

PTR 

PZE 

SPACES 

PZE 

XSAV  PZE 
ASAV  PZE 
BSAV  PZE 
INPT 

PZE 

BUF 

RES 

500 

END 

BEGIN 

/^E0F, 
^ENDJOB. 
&  JQ3  • 
aREWIND 
AL8AD  0/ 


RE  ANY  MQRE  ReULS 

FOR  this  mission  > 

RE  ANY  MORE  MISSIONS 

FOR  THIS  MAG  TAPE  > 

RE  MORE  MAGNETIC  TAPES  > 

A  NEW  MAG  TAPE  > 
magnetic  TAPE.  MOUNT 

NEW  TAPE/  AND  RESTART 
MISSION.  > 

ESPONSES  ARE  Y  OR  N.  > 


Bo  * 
GO. 
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IBFTC  GUAK  NeOECK 

PR8QRAM  TO  CONTROL  INPUT  OUTPUT  DEVICIES 
CALLS  QUACK  WHICH  PROCESSES  THE  DATA 
COMMON  INPUT  -  DATA  READ  INTO 

LCODE  -  ARRAY  IN  WHICH  UNPACK  THE  DATA 
COMMON  /X/  MONdS)  -  MONTHS  TO  BE 

PROCESSED  WITH  OVERFLOW  SLOT 
INUM  -  NUM  OF  months  TO  BE  PROCESSED/  MAX  IS 
IAREA(5/4)  -  AREAS  TO 

BE  PROCESSED/  WITH  OVERFLOW  SLOT 

inumx  -  num  of  areas  to  be  PROCESSED/  max  4 

ISUM(4/4/99)  -  4  GROUPS 

OF  CHARACTERISTICS  FOR  EACH  AREA 
IST(aOO/30)  -  STATION  AREA 
NUMST  -  num  of  STATIONS/  MAX  200 
IXXI  -  number  of  soundings  PROCESSED/ 

ZERO  at  START  OF  NEW  MONTH 

DIMENSION  INPUT{316)  315  WORDS  PLUS  OVERFLOW/  MAX  315 
LCeDE(6/3l5)  6*315  WORDS  -  UNPACK  ARRAY 
IDAY(12)  ^  NUM  DAYS  IN 

month  in  a  FORMAT/  WHERE  MONTH  IS 
GIVEN  BY  THE  INDEX 


COMMON  INPUT/LCODE 

common  /X/  MONI 13)/ INUM/ IAREA(5/ 

4)  /  INUMX/ ISUM(4/4/99)/ I  ST (200/ 30)/ 

1NUMST> IXXI 

DIMENSION  INPUT (316) /LCODE (6/ 315 )/  IDAY( 12) 
DATA  IDAY( 1 )/ IDAY(2)/ IDAY(3)/ IDAY(4 )/ 

IDAY(5)/ IDAY(6)/ IDAY(7)/ 

1  IDAY(8)/  IDAYO)  /  IDAY(IO)/  IDAY(  11  )/  IDAY(  12)/ 
26H  .  31/6H  28/6H  31/6H 

30/6H  31/6H  30/6H  31/ 

36H  31/6H  30/6H  31/6H  30/6H  31/ 

WRlTE(6/300) 

300  format (IHl) 


INITIALIZE  MONTH  AND  AREA  COUNTER 
INUM=0 
INUMX=0 
C 

C  READ  IN  MONTHS  TO  BE  PROCESSED  IN  TIME  ORDER 
C  SETS  MONTH  COUNTER/  INUM  MIN»1  MAX=12  IF  OTHER  STOP 
C  BLANK  CARD  MARKS  END  OF  DATA 
DO  18  1=1/13 
INUM=INUM+1 
READ(5/4)MeN( INUM) 

A  FORMAT! 12) 
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18  ir(MeN( INUM) .EQ,0)G0T85 
888  PRINT  5013 

5013  F8R'1AT(//23H  M8NTH  REQUEST  IN  ERR8R//) 

STOP 

5  INUMsINUM-1 
IFUNUM.LT.l)GeT0888 
PRINT  19/ (M0N( I )/ Isli INUM) 

19  F8RMAT(//24H  months  TO  BE  PROCESSED/ / 12 ( 1 3 )// > 

C 

C  READ  IN  AREAS  T0  BE  PROCESSED 

C  SET  ATEA  COUNTER/  INUMX  MIN=1  MAX^A  IF  OTHER  STOP 
C  BLANK  CARD  MARKS  END  OF  DATA 
DO  218  Iel/5 
INUMXsINUMX+1 

READ (5/ 6) { IAREA( INUMX/ J)/ J«l/4) 

6  F8RMAT(AI6) 

218  IF( IAREA( INUMX/1 ).EQ.O)G8T015 
1888  PRINT  5113 

5113  F0RMAT(//29H  LAT  AND  LOO  REQUEST  IN  ERROR//) 

STOP 

15  INUMX=INUMX-1 

IF( INUMX»LT.1)G8T01888 

PRINT  119/  (  (  IAREA(  1/ J)/ J  =  l/A)  /  Ul/  iNUMX) 

119  FeRMAT{//22H  AREAS  TO  BE  LOOKED 

AT///3X/AHLAT1/3X/AHLAT2/3X/ 

14HLQG1/3X/4HL0G2///4(4I7//)///) 

C 

C  initialize  all  flags  AND  COUNTERS  BEFORE  STARTING 
ITAPE«0 
IFLAG-0 
IXXI=0 
ICNT=1 
PRINT  9123 

9123  F0RMAT(34H  NEED  BLANK  TAPE  ON  UNIT  B5  AND  B6/// 
122H  MOUNT  TAPE  ON  UNIT  A5///) 

G0TO24 

C 

C  REWIND  PREVIOUS  INPUT  TAPE  AND  WRITE 

operator  instructions 

C  OPEN  NEW  FILE/  SET  FLAG  FOR  NEXT  INPUT  TAPE  (IMT) 

C  increment  input  tape  COUNTET  (ITAPE) 

C  START  OF  LOOP 

10  IF( IMT.EQ»-1)G0TO22 

rewind  10 
PRINT  5011 

5011  F0RMAT(//22H  MOUNT  TAPE  ON  UNIT  A5/ 

1//24H  UNMOUNT  TAPE  ON  UNIT  A6//) 

24  CALL  OPENl 
IMT»-1 
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itapesitape+i 

6876212 

22  continue 
rewind  9 
PRINT  5002 

5002  F9RHAT(//22H  MOUNT  TAPE  ON  UNIT  A6/ 

1//24H  UNMOUNT  TAPE  ON  UNIT  hbf/) 

CALL  0PEN2 
IMTsl 

ITAPE=ITAPE+1 

C 

C  READY  TO  PROCESS  DATA 
C  IF  IFLAQ  0^  beginning  OF  RUN 
212  IMQn*MON( ICNT) 

CALL  QUACK( IMT/ IMON/ IFLAG) 

C 

C  IXXI>  total  number  of  soundings  used  FOR  PRESENT  MONTH 
C  IF  IFLAG  2/  MONTH  REQUEST  DOES  NOT  MATCH  DATA 
C  IF  IFLAG  1/  NEED  NEW  MONTH 
C  IF  IFLAG  -1/  NEED  NEW  TAPE 
C  IF  IFLAG  -2/  COULD  NOT  FIND  STARTING  MONTH 
PRINT  6082; IFLAG/NUMST/ IXXI 

6082  F0RMAT(//5H  FLAG; 1 3; 5X; 19H  NUMBER  OF  STAT I ONS; I b; 5X; 
120H  number  OF  SOUNDINGS; Ib;/) 

IF( IFLAG.EQ»2)G0T02778 
IF( IFLAG*EQ.1)G0T66O2 
IF( IFLAQ. EQ»-1 )G0TO6O3 
C 

C  starting  MONTH  NOT  ON  TAPE 
PRINT  1819 

1S19  FORMAT I/;27H  STARTING  MONTH  NOT 

ON  TAPE;/;14H  FORCED  FINISH;/) 

G0T0.816 

MONTH  REQUEST  DOES  NOT  MATCH  INPUT  DATA 
2778  ICNT=ICNT-1 

PRINT  2887; (MON( I); 1=1; ICNT) 

2887  FeRMAT{/;55H  NEXT  MONTH  REQUEST 

DOES  NOT  MATCH  WITH  NEXT  INPUT  DAT 
1A;/;19H  PROCESSED  MONTHS;  ;12(I3);/) 

G0Te816 

need  new  MONTH 
602  CALL  OUTPUT! IMON) 

IF! ICNT.EQ. INUM)G0TQ1777 

PROCESS  NEXT  MONTH 
ICNT=ICNT+1 
IXXI=0 
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G8T0212 

C 

C  finished  all  H9NTHS  DESIRED  gUT  ADDITIBNaL  INPUT 

1777  PRINT  1778/ (M6N{  Ui  I*U  ICNT) 

1778  F0RMAT(//49H  ADDITI8NAL  INPUT 

BUT  finished  all  MONTHS  DESIRED/ 

1//8H  N8NTHS  /12( 13)//) 

GdTe816 

C 

C  NEED  NEW  TAPES 
603  PRINT  729 

729  FSRmaT(//53H  KEY  35  D0WN  F0R  ADDITIONAL 

INPUT/  UP  TO  FINALI7,E  JOB/ 

1/) 

PAUSE 

CALL  KEYS (WORD) 

IF(IBIT(W0RD/35) .EQ»1)G0T010 

NO  ADDITIONAL  INPUT 

CHK  3UFF  DAYS  PRES  TO  CNT'  MONTH  OR  ONLY  ONE  MO  TO  PROCESS 
IF(INPUT(4).NE.IDAY(IM0N)»AND.INUM.NE.1)  go  TO  705 
c 

C  FINSIHED  PRESENT  MONTH 
CALL  OUTPUT! IMON) 

IF( ICNT.LT. INUM)G0TO7O4 
C 

C  ALL  months 

PRINT  2771/ (MONI I )/ Isl^ ICNT) 

2771  FQRmaT{//30H  FINISHED  ALL  MONTHS  DESIRED/  /12(I3)//) 
GOTO  816 

C  , 

C  PROCESSED  SOME  MONTHS 
705  ICNTsICNT"! 

IF( ICNT.LT. 1)G0T8614 
704  PRINT  701/ (M0N( 1)/ Iflfl, ICNT) 

701  F0RmAT(//24H  PROCESSED  SOME  MONTHS/  /12(I3)//) 

G0TO816 

C 

C  NO  OUTPUT 
614  PRINT  714 

714  FeRMAT(//30H  NO  OUTPUT/  INPUT  INSUFFICIENT//) 

C 

c  TAKE  Care  of  input  output  devicies 
816  IF(IMT.EQ«1 IGOTOSII 
REWIND  9 
END  FILE  11 
END  FILE  12 
rewind  11 
rewind  12 
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PRIM  2001/  ITAPE 

2001  P9RMAT(//22H  UNMOUNT  A5/  B5  AND 

B6///27H  NUMBER  OF  INPUT  TAPES  USE 
ID,/  I3///9H  F  INISHED//) 

STOP 

811  rewind  10 

END  FILE  11 
END  FILE  12 
rewind  11 
rewind  12 
PRINT  2C02i  ITAPE 

2002  FORMAT (//22H  UNMOUNT  A6/  B5  AND 

B6///27H  NUMBER  OF  INPUT  TAPES  USE 
10/ I3///9H  FINISHED//) 

STOP 


END 

$I5FTC  work  NODECK 

C  program  to  change  format  of  SOUNDING  FROM  ALPHANUMERIC  TO 
C  FLOATING  FT  AND  INTERGER.  COMPILIES 

STATISTICS  ON  the  QUALITY 
C  OF  THE  STATION.  CALLS  DUCT  WHICH 

LOOKS  FOR  LAYERS  AND  COMPILIES 
C  STATISTICS.  CHECKS  DATA  TO  SEE 

IF  PROCESSING  MONTH  OF  DATA 
C  DESIRED/  IF  NOT  RETURN. 

C  DIMENSION  INPUT(316)/KPUT(21/15)  INPUT  ARRAY 

C  LCeDE(6/3l5)/FC0DE(6/3l5) 

USED  TO  UNPACK  AND  EVALUATE 
C  LEVEL  data 

C  IEND(6/9)/FEND(A/9)  USED 

TO  UNPACK  AND  EVALUATE 
END  DATA 

ILT(12)  USED  AS  A  GENERAL  UNPACKING  ARRAY 

Data  iraob  alphanumeric  raob  identifier 

iwxv  octal  equivalent  record  mark 


SUBROUl INE  QUACK! I JLM^ IMON/ IFLAG) 
common  INPUT/LCODE 
common  /X/  MON(  13)/ INUMMAREA(5/ 

4). INUMX# I  SUM (4/ 4/ 99)/ I  ST (200/ 30)/ 

INUMST/ IXXI 

dimension  INPUT(316)/KPUT(21/15)/ 

LC0DE(6/315)/FCeDE(6/3l5)/ 

1  IEiND(6/9)/FEND(6/3)/  ILT(  12) 

EQUIVALENCE  ( I NPUT/ KPUT ) / ( LCODE/ FCODE ) M lEND^FEND) 
DATA  IHA08/ IWXV/6HRA0B  / 0606060606072/ 

C 

C  IF  IFLaG  0/  LOOKING  FOR  FIRST  MONTH  DESIRED 
C  IF  IFLAG  -1/  NEW  INPUT  TAPE 
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IF  IFLAG  It  NEW  M0NTH 


START 

IF( IFLAG. EQ.-1)G0T82 

INTIALI2E  F8R  PRBCESSING  0F  NEW  N8NTH 
IXFLA=0 
NUMSTsO 

ZERO  ISUN  ARRAY 

D0  1101  I*1/INUMX 
DO  1101  Jsl>4 
DO  1101  K=l/99 
1101  ISUM( IiU^K)sO 

CALL  eUTX( l/0./0.#0./0. ) 

IFUFLAG.EQ.I  )GOT0312 

START  0F  LOOP 
2  CONTINUE 

REMOVE  C  FROM  F0LL0WINQ  CARD  IF  WANT 

TO  STOP  PROCESSING  AFTER  A 

A  GIVEN  NUMBER  0F  SOUNDINGS 
IFdXXI.GT.  )G0TO4O76 

READ  records 

CALL  IN(LiL0CK/ lULM) 

IF( IFLAG.EQ.O.AND.L0CK.EQ.1)GOT61333 
IF(LeCK.EO.l)G0Te778 

TEST  TO  SEE  IF  WANT  TO  EVALUATE  LEVEL 
DATA  0F  present  sounding 
312  IF(INPUT(1).NE.IRA0B)G0T02 

CALL  DEC0OE(INPUT(5)/ILT(l)d) 

IF(1LT(5) .EG.48) ILT(5)*0 
IM0nX=10*ILT(5)+ILT(6) 

IFUM0NX.NE.  IM8N)GOT04O62 

evaluate  level  DATA 

TEST  FOR  LAST  RECORD  MARK 

IF(INPUT(L-1) .EQ.IWXV.AND.INPUTCL) .EQ. IWXV)L’L-1 
IFIINPUTIL) .NE.IWXV)L»L+1 
C 

C  INITIALIZE  overflow  FLAG 
C  CHECK  SIZE  OF  SOUNDING  THAT  CAN  READ  IN 
UFLAG=0 

IF(L.LE.315)G0T08O8 
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C 

C  flag  if  N0T  READ  IN  CeNPLETE  SOUNDING 
C  OVERFLOW/  HAVE  AT  LEAST  48  DATA  LEVELS/ 

BUT  D0  NOT  HAVE  END  INFO 

UFLAG=88 

L-322 

C 

C  IREC/  number  of  complete  logical  records 
C  IREM/  number  of  data  WORDS  REMAINING  LESS  END  DATA 
808  IREC*L/21 

IREMsM0D(L/21  )-U 
IF( IREM.EQ«-ai) IREM=-10 
IF(IKEM)28/28/3 
28  IREC=IREC-i 
IREM=IREM+20 
C 

C  DECODE  THROUGH  LAST  LEVEL  DATA  POINT 

3  CALL  DECODE! INPUT{9)/LC0DE( 1/1)/12) 

Ke  13 

IF(  IREC.i-T.2)GeT84 
DO  10  I?>2/1REC 

-  CALL  DECeDE(KPUT(l/ n/LCeDE(l/K)/20) 

10  K*K+20 

4  CALL  DEC9DE(KPUT(1/IREC+1)/LC8DE(1/K)/IREM) 

C 

C  NUMBER  OF  PRESSURE  LEVELS  WITHIN  THE  SOUNDING 
C  DO  NOT  EXCEPT  SOUNDING  IF  LESS  THAN  4  PRESSURE  LEVELS 
LL-(L-(19+(L/21)  )  )/(? 

JF( IREM»EQ»10)LL=(L-{ 18+(L/21 ) ) )/6 
L  ^  LL 

IF(L»LT«4)G8Te)2 

C 

C  EVALUATE  LEVEL  DATA 
C  N  CONTROLS  DATA  WITHIN  EACH  LEVEL 
C  NN  controls  number  OF  LEVELS  PROCESSED 
C  I  I  WORD  WITHIN  DATA 
C  UJ  level  OF  DATA 
N  =  0 
NN  =  0 

DO  99  J=l/315 
IF! J*EG.N+7 )NsN+6 
II=U-N 
UJpi+NN 

IF! jJ.GT»L)QOT098 
IF!  I  I/6.EQ.  1  )NN;=NN+1 
D0  12  1=1/6 

IF!LC0DE! 1/ J) /EQ«16)LC8DE! 1/ J)»0 
12  IF!LCfiDE! I/U) .EQ.48)LCeDE! 1/ J)*0 
MARK=0 
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D0  11  1=1/5 

IF(LC0PE( 1/ J) .EQ.32)G8T0563 
11  C0NTINUE 
G9TS141 
563  MARK=1 

i.ceoE(  U  J)=0 

C 

C  CHECK  FOR  FL9ATING  PT 

141  ir(LC0DE(5/ J) ♦EQ*a7)GOT03l 
C 

C  CHECK  for  D  in  first  CHARACTER 
1F{I.C0DE(6/U)  .EQ.2O)G0TO32 

LC0DE(  II/UJ)=tC0DE(6/ J)  +  l0*LCeDE(5/U)  +  100»l.C6DE(4/ J) 

I  +  IOOO-^LCODEO/ J)  +  10000*LCeDE(2/ J) 

IF(MaRK.EQ»1  )LC0DE(  II/ JJ)=-lC0DEn  1/ JJ) 

G0T999 

31  continue 

FCODEC II/ JJ)=FLOATaC0DE(6/U) )^»1+FL0AT(LC0DE{4/ J) ) 
1+FL0AT(UCODE(3/ J) ) ♦ 10/ 0+FL8AT < UC0DE ( 2/ J ) )*100.0 
IF(maRK.EQ.1 )FCODE(1 1/ JJ)»-FCeOE( 1 1/ JJ) 

G0T999 

C 

C  replace  wind  direction. with  999999  IF  INCONSISTENT 

32  LCeOE( 1 1/ JJ)=999999 
99  CONTINUE 

C 

C  SEE  IF  EXCEPTABLE  VALUES  FOR  PRES/  TEM/  AND  DEW  PT 
C  IF  NOT/  DO  NOT  CONSIDER  SOUNDING 
DO  (,099  U*1/LL 

IF(LC0DE(1/U) .GT. IIOO.OR'LCODEI 1/U) .LT.OIGOTOa 
IF(FCeDE(3/U) »GT.75*O«OR.FC0DE(3/ J) .LT»-lOO.O)G0Te2 
IF(FC0DE(4/ J) .EQ.99.0)GOTe6099 
IF(FC0DE(4/ J) .GT«FC0DE(3/ J) .OR.FCODEIA/ 

U) .LT.-1OO.O)G0T02 

6099  C0NTINUE 
C 

C  CHECK  PRESSURE  OF  FIRST  FOUR  LEVEL 

DATA  POINTS  TO  SEE  IF  WILL 
C  EXECPT  SOUNDING 
98  DO  7389  1=1/4 
7389  IF(LC8DE(1/ I ) .LT.IOOIGOTOE 
C 

C  will  except  SOUNDING/  INCREMENT  SOUNDING 

COUNTER/  CLEAR  IFLAG 

IXXI*IXXI+1 

IFLAG=99 

C 

C  DECODE  END  DATA 

IF( jFLAG.EQ.88)QeTe767 
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KK=IREh+8 

IF(KK.GT«2O)G0Te511 

Ks2l-KK 

IF(K.GT*9)K=9 

CALL  DECODE  (KPUKKK,  IREC  +  1 )  /  lEND  (1/ 1  ),K) 
IF(K.EO»S)G0TO46 

CALL  DECODE  (KPUTd#  IREC  +  2 )  >  I  END  (1#  K+1  )  ,  9-K  ) 

Q8T046 

511  CALL  0EC8DE(KPUT(KK-a0i IREC+2)/ IEND(l,l)/9) 

C 

c  evaluate  end  data 

46  DO  76  I=l#9 
DO  34S  11*1/6 

IF( IEND( II/ 1 ) .EQ*16) IEND( 1 1/  1 )*0 
248  IF(  lENDd  1/  I  )  »EG.48)  IENDU  1/  I)*0 
IF( I .EQ.4)GOT076 
IF( I .EQ.6)GOT076 
IFd  *EG.3)QeTe74 

lENDd  /  I  )  =  IEND{6/  I  )  +  IEND(5/  I  )^‘10+IEND(4/  I  )*100 
l  +  IEND(3i I) *1000+ I  END (E/ I ) *10000 
G9Te76 
74  NARK*0 

DO  1112  11=1/6 

1112  IF( IEND{ II/ I) .EQ.32)GOT01113 
G0T0174 

1113  lENDl I  1/ I ) =0 
MARK=1 

174  FENDd/ I I^FLOATI I  END (6/ I ) )*.l  +  FLeAT( IEND(4/ 1 )  ) 
1+FL0AT( IEN0(3/ I ) )*10»O+FLOAT( IEND{2/ I ) )*100»0 
IF  (  mark*  EQ  d  )  FENDd  /  I  )= -FENDd  /  I  ) 

76  continue 
767  continue 
C 

C  IF  WANT  TO  PRINT  0UT  EVALUATED  DATA/ 

REN0VE  C  FROM  FOLLOWING  CARDS 
C  write (6/ 6092) ( INPUT! I )  /  1  =  1/8) 

C6092  F0RMAT(//8dX/A6)  ) 

C  DO  6098  KJ=1/LL 

C6098  WRITE (6/ 6038) ( LCODE ( K/ KU ) / K» 1 / 2 ) / ( FC0DE ( K/ KJ) / K»3/ 4 ) / 
C  1 (LC0DE(K/KJ)/K=5/6) 

C6038  F0RMAT(2I8/2F9. 2/218) 

C  IF(UFLAG*EQ.88)G0T01489 

C  write  (6/ 6048)  (  IEND(  1/K)  /  K  =  l/2)/FENDd/3)/  IENDd/5)/ 

C  ldENDd/K)/Ks7/9) 

C6048  F0RhAT(2I8/F9. 2/418) 

C1489  CONTINUE 
C 

C  COMPUTE  eat  AND  L0G 

CALL  DECODE! INPUTI6)/ ILTd )/2) 
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MAK1=C 
MAK2=0 
D3  9088 

IF(ILT(  n  <E0*16)  IIT(  I  )«:0 
1F(ILT( I ) .NE.32)G3T09O83 
IF(ILT(n,EQ.48)ILT(I)*0 
IF(I  .l.E.6)MAKl  =  l 
IF( I.GE.7)MAK2=1 
ILT( I)*0 
9028  continue 

LAT^ILT(2)*J0000+ILT(3)»1000+lLT(4)i^ 
J00+ILT(5)»10+ILT(6) 
IF(NAK1.EQ.1 )LAT?^LAT 
U8G?ILT(8)*10000+ILT(9)*1000+ILT(10)* 
100+,ILT(11)*10+ILT(12) 
IF(MAK2*EQ«1  )l,8G»-L0G 
C 

c  flag  if  sig  levels 

DO  S109  I=liL 

8109  IF(N8D(LC9DE(1/ I ) i 50 ) . GT • 0 ) G0T881 10 
ISiQsO 

G0T88111 

8110  ISiGsl 

Sill  continue 
PUT  data  in  station  array 

ARRAY  IST(I^J)  I  -  INDEX  FOR  STATIONS 

u  -  counters  for  a  • 

C  GIVEN  STATION  1  NUM  2  LAT  3 

LOG  4  EL  5  NUN  TOTAL  SND 
C  6  NUM  sig  levels  7  NUM  OF  SUR  MEASURE 

8  AVG  pres  9  AVG  TEM 

C  10  AVG  DEH  PT 
C 

IF(nUMST.EQ.0)G6T01756 
DO  1864  KLh=l/NUMST 

1864  IF( INPUT(2) .EO.IST(KLMi 1) )G0TO1865 
C 

C  PREPARE  ARRAY  FOR  NEW  STATION 
1756  IF(NUMST*EQ»800)G8T08900 
NUMsT'NUMST+1 
KLMsNUMST 

IST(KLM,1)sINPUT(2) 

IST(KLM,2)»INPUT(6) 

IST(KLMj3)=INPUT(7) 

IST(KLM/4)»:INPUT(8) 

DO  8113  I=5#30 
8113  IST(KLMW)=0 
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C 

C  TREAT  AS  OLD  DATA 
1865  IST(KLM/5)=IST(KLM/5)+l 

IF( ISIG«EQ»1 ) IST(KLM/6)»IST(KU^/6)+1 
IF{ IEND(1^5) •EQ.O.0R. JFLAG.EQ.88)GeT0734l 
JST{KLM^7)*IST(KLM/7)+l 
IST(KLM/8)  =  IST(KLM/8)+LC8DE( li  1 ) 

DEL*. 5 

IF(FCBDE(3/1)  .LT.0.0)DEL  =  -^DEL 
IST(KLM^9)*IST(KLM/9)+IFIX(FC0DE(3/l )*10«0+DEL) 
DEL*. 5 

lF(FC0DE(‘t/l )  .LT.0«0)DEL*=-D£L 

IST(KLM^10)*IST(KLM/10)+IFlX(FCeDE{4/l )*1Q»0+DEL) 
7341  CALL  LAYER(L/KLM/LAT/LeG) 

G0T92 

C 

C  DO  NGT  EXCEED  M0RE  THAN  200  STATIONS 
C  IF  exceed  200  STATIONS  WRITE  NOTE 

8900  IF(  IXFLA.EQ.nGOTOE 
IXFLA-1 

PRINT  8901 

8901  FDRnAT(47H  MORE  THAN  200  STATIONS^ 

0NLY  PROCESS  FIRST  200) 

G0TO2 

C 

C  CeULD  N0T  FIND  DESIRED  MONTH 
4062  IFnFLAG.EQ.O)GeT02 
IF( IXXI .NE.O)G0T04O76 
C 

C  MONTH  request  DOES  NOT  MATCH  DATA 
IFLAG=2 
RETURN 
C 

C  RETURN,  NEW  MONTH 
4076  IFLAG*1 
RETURN 

RETURN,  END  OF  FILE 
778  IFLaG=-1 
RETURN 
C 

C  RETURN,  STARTING  MONTH  NOT  ON  TAPE 
1333  IFLAGb-2 
RETURN 
END 

$IBFTC  QT  NODECK 

C  program  to  CREATE  A  PROFILE  OF  TEM, 

DEW  PTi  HEIGHT/  REFRACTIVE 
C  INDEX,  and  GRADIENT  USING  DATA  GIVEN 

AND  EXPANDING  FOR  2MB 
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C 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 


PRESSURE  LEVELS. 

L09KS  THRQUGH  PReFiLE  TO  FIND  LAYERS 

8F  CONSTANT  GRADIENT  AND 

increment  appropriate  counters  for  the  given  station  . 

DIMENSION  DATA(5/501)  THE  ARRAY 

IN  WHICH  THE  PROFILES  ARE  MADE 
DATA(I,J)  1*1  TEMP 

1=2  DEW  PT  I^S  height 

1=4  REFRACTIVE 
INDEX  1=5  gradient 

J«1  1100  MB  sJ=501  100  MB 

J=0THER 

SCALED  VALUE  IN  2MB  LEVELS 
SUBROUTINE  LAYER(L/ I JKL^ LAT; LOG ) 

common  input^lcode 

common  /X/  MONdG)/ INUM/ 1AREA(5/ 

4)  /  INUMX/ ISUM(4/4/99)/ IST(200/30)/ 

INUMST/ IXXI 

DIMENSION  INPUT(316)/LC0DE(6/315)# 

FC0DE( 6/315) /DATA ( 5.501 )#IL(6) 

EQUIVALENCE  ( LCODE/ FCODE ) 

CHECK  FIRST  PRES  LEVEL 

IF ( LCODE ( 1/1 ) .GT.1100)LCeDE( 1/1 >=1100 

FIND  FIRST  REF  POSITION  WITH  RESPECT  TO  PRES 
Il=551-LC0DE(l/l)/2 
IBASE=U 


PUT  IN  FIRST  TEM  AND  DEW  Pj 
DATAd/  Il)=FCeDE{3il) 

DATA(2/I1)=FC-0DE{4/1) 

C 

C  insert  TEM  AND  DEW  PT  WITH  REF  TO  2MB  PRESSURE  LEVELS/ 

C  and  expand  between  DATA  POINTS  1  TEM  2  DEW  PT 

DO  88  JK=2/L 

IFILCODEI  1/vJK)  .GT.  1100 ILCODE  11/ JK)  *1100 
IF ( LCODE ( 1/ JK) .LT. 100) GOT089 
I2  =  551-LC00E(  l/vlK)/2 
DATAd/  I2)=FC9DE(3>  JK) 

DATA(2/ I2)»FCeDE(4/ JK) 

DIV*I2-I1 

DEL2=(DATAd/  I2)-DATA(1/  ID  )/DIV 
MARK=0 

IF(DATA(2/ H ) . EQ. 99.0) MARKS  1 
IF(DATA(2/ 12) .EQ. 99.0) MARKS  1 
DEL3=(DATA(2/  I2)-DATA{2/  id  )/DIV 
III=DIV-1.0 
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DO  903 
XI  =  I 

JJKsIl+I 

DATA(  lis)UK)=DATA(  1/  I1)+DEU2*XI 
DATA(2^UJK)=DATA(aWl  )+DEL3*Xl 
903  IF(HARK,EQ.1)0ATA(2/UJK)*99.0 
88  11=12 
JK  =  L 


eliminate  portions  of  dew  pt  profile 

WHERE  DATA  DOES  NOT  EXIST 
C  EXPAND  BETWEEN  GIVEN  VALUES  AND  IF 

LAST  value  of  DEW  PT  IS  GONE^ 

C  ASSUME  TO  BE  -100  AT  LOWEST  PRESSURE  LEVEL  GIVEN 
89  IBAsO 
IEN  =  0 

DO  9901  I=IBASE/I2 
IF (DATA (2^ I ) .NE.99«OO)G8T099O5 
IF( IBA»EQ*0) IBA=I-1 
IF(I .NE. I2)G0Te990l 
9905  IF( IBA.EQ*0)G0T0990l 
IEN=1 

IFdEN.EQ*  I2)DATA{2/  ia)=-100.0 

DIF=(  (DATA(2dEN)-DATA(2/  IBa)  ) /FLOAT  (  I  EN- I  BA  )  ) 

IBAsIBA+1 

IEN=IEN-1 

DO  9902  U=IBAdEN 

J J  =  U“  1 

9902  DATA(2/U)aDATA(2>UJ)+DIF 
IBApO 
lENcO 

9901  continue 
C 

C  SET  REF  HEIGHT  IN  METERS 
REF=.LCQDE(2il ) 

IF(REF.EG)»0f0)G8T01566 
CALL  DECODE! INPUT(8)/ ILi 1) 

DO  888  IU=1#6  . 

888  IF( IL( I J) ♦EQ»48) IL( IJ)*0 

EL=IL(6)+10*IL(5)  +  100♦IL(4)  +  1000^^IL(3)  +  10000*IL(2) 
REFpREF*3. 04801-EL 
C 

C  COMPUTE  the  height  USING  REF  HEIGHT 

AS  FIRST  HEIGHT  3  HEIGHT 
1566  DATA(3/ IBASE)=REF 
H  =  IBASE  +  1 
DO  906  1=11/ 12 
P1=(552-I )*2 
P2=(55l-I )*2 


62 


o  n  o  o 


QUACK  PAGE  14 

DATA(3> I)sREF+HEIGH(P1,PS>DATA(1/ 

I-1)^DATA(1/ I)/DATA(P,I-1)^ 

1DATA(H/ I ) ) 

906  REFsDATAO/ I  ) 

C 

c  compute  the  refractive  index  4  refractive  index 

,  DO  22  JKcIBASEi 12 

22  DATA(4/UK)=XlND(FEaAT( (551-JK)* 

2)/DATA(l>UK)/DATA(2y UK) ) 

C 

C  COMPUTE  the  gradient  5  GRADIENT 

I3-I2-1 

DO  23  JKsIBASE^ 13 

23  DATA(5^UK)=( (DATA(4/ JK+1)-DATA(4/ JK) ) *1000*0) 
1/(DATA(3^ JK+1)-DATA{3aJK) )+.5 


FIND  LAYERS  OF  CONSTANT  GRADIENTS 
IF  layer  EXISTS/  FIND  HEIGHT  AND  THICKNESS 

ixflag»o 

XMAXs-10000 
DO  666  IIJ=1/10 

XMlNrXMAX 

IF( 1 1 J.E0*6)XMIN*"XMIN 

GOTO (701/ 702/ 703/ 704/ 705/ 706/ 707/ 708/ 709/ 710) 4  1 1 J 

701  XMAX5-1000 
ISGN*1 
GeT89817 

702  XMAX*^500 
GOTOSai? 

703  XMAX=-150 
GOT09817 

704  XMAXs^lOO 
ISGNs2 
WWs-150.0 
G0Te98l7 

705  XNAX*-75 
G0TO9817 

706  XfiAX?10C 
ISGn=3 
WWa75*0 
G0T99S17 

707  XMAX'ISO 
GOT09817 

708  XMAX=500 
ISGN=4 
G0T09817 

709  XMAX?1000 
60Te98l7 
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710  XMAX=10000 
C 

C  N6/  flag  if  surface  AND  ELEVATED 

LAYERS  OCCUR  WITHIN  A  GIVEN  PROFILE 

9817  N6SR=0 
N6EL=0 

C  N3sl#  LAYER  OCCURING 

C  N4/  NUM 

OF  intervals  for  the  layer 

N3  =  0 
N/+  =  0 

DO  666  I=IBASE/I3 

c  test  for  layer 

IF (DATA (5/ I ) .LT.XNIN.eR,DATA(5^ I ) .GE. XMAX ) G8T0610 
C  LAYER  EXISTS 

N3  =  l 
N4PN4+1 

IF( I .NE. I3)G8Te666 

C  LAYER  MUST  END 

IENDX=ia 
G8Te6ll 

610  IF{N3«EQ.O)GOT0666 


C 


611 


IENDX=I 

IBEG?IENDX-N4 


LAYER  ENDED 


C 

C 

C 


HTsDATA(3/ IBEG) 
TH=DATA(3> IENDX)-HT 


SUM=0«0 


FIND  BOTTOM 
FIND  THICKNESS 
FIND  THE  GRADIENT 


IX* IENDX-1 
DO  612  IIsIBEG/IX 
612  5UM  =  SUM+DATA(5> I  I ) 

GR»SUM/FL0AT(N4) 

C  INDEX  FOR  THE  HEIGHT 

INDX1?HT/100*0+1.0 
IF( IN0X1.LT.1)INDX1=1 
IF( IN0X1.GT.51 ) INDX1=51 

C  INDEX  FOR  THE  THICKNESS 

INDX2-TH/25. 0+1.0 
IF( INDX2.LT.1) INDX2*1 
IF( INDX2.LE.20)G0Te5041 
I NDX2s(TH-499. 01/250* 0+21.0 
IF( INDXa.GT.23) INDX2*23 

C  INDEX  FOR  THE  GRADIENT 

5041  G0T0(74l/742^742/743)/ ISGN 
741  INDX3=IFIX( (GR+1000.0)/35.6)+2 
IF (QR.LT.- 1000.0 ) INDX3sl 
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G8T0^^14 

7A2  lNDX3sIFIX(  (GR.«WW)/3»04)->-l 
G0TD41A 

743  INDX3«IFIX( {GR-1000»0)/35.6)+l 
IF (GR'GT. 1000.0) IN0X3»25 

INCREflENT  LAYER  C8UNTERS  WITH  RESPECT  T8  THE  SURFACE 

ARRAY  IST(I/J)  I  -  INDEX  F8R  STATI8NS 

J  -  C8UNTERS  F8R  GIVEN 

STATI8N  11-aO  NUM  SUR  LAYERS  21-30  NUM  EL  LAYERS 

414  IF(N6SR.EQ.1)G8T86668 
N6SR=1 

IF(HT-^EL.LE.IOO.O)  IST(  IJKL/  1 1  J+10)sIST{  lUKLi  1 1  J  +  10)  +  l 

6668  IF{N6EL.EQ.1)G0T06669 
N6EL-1 

IF(HT  +  EL.GT.100.0)  IST(  IJKL/  1 1 J+20 )  *  I  ST  (  I JKL/  I  IJ4-20)+l 

6669  N3=0 
N4«0 

FLAG  IF  FOUND  A  DUCTING  LAYER 
IF (GR.lt.- 157.0) I XFLAG*1 
C 

C  INCREMENT  CHARACTERISTIC  COUNTERS  WITH  RESPECT  T8  AREA 
D8  5146  KKXsl/ INUMX 
IF( IAREA(KKX/ 1 ). EG. 999999 )GeT85046 

IF(LAT.LT. IAREA(KKX/1) .0R.LAT.GT. IAREA(KKX/2) )G0T85146 
1F(L8G.LT. IAREA(KKX/3) .OR.LOG.GT. IAREA{KKX/4) )G8T85146 
5046  ISUM(KKX/ ISGN^ I NDXl )  =  I  SUM ( KKX, I SGN/ INDX1)  +  1 

ISUM(KKXi ISGNi INDX2+51)sISUM(KKX/ ISGN/  INDX2+5l)  +  l 
ISUM(KKX/ ISGN/ INDX3  +  74)*ISUM(KKX/  ISGN, INDX3  +  74)  +  l 
5146  continue 
666  CONTINUE 
C 

C  FLAG  IF  NOT  FOUND  DUCTING  LAYER 
ISTA»I JKL 

IF(IXFLAG.EQ.0)ISTA*0 

CALL  FREQX(DATA/ IBASE/ I3>LAT#L0G^ ISTA) 

RETURN 

END 

$IBFTC  FREQ  NODECK 

SUBROUTINE  FREQX(DATA/  IBOTi  I  TOP/ LAT  AOG/  I STA  ) 

common  INPUT/LCODE 

common  /X/  MeN(13)^ INUM/ IAREA(5/ 

4)  /  INUMX/ I  SUM (4/ 4/ 99)/ I  ST (200/ 30)/ 

INUMST/ IXXI 

DIMENSION  INPUT(316)/LC0DE(6/315) 
dimension  DATA(5/501) 
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convert  n  profile  t0  m  profile 

00  1  I^IBOT/ITOP 

0ATA(4-»  I  )»DATA(4/  I  )  +  (DATA(3/  I  ) /6370 . 0  )  *1 . OE  +  3 
1  DATA(5/ I )?DATA(5i I )+157.0 
C 

C  SET  VARIABLES  TO  FIND  MIN  TRAPPING  FREQ  AND  HEIGHT 
FRQ=959999 
HTS999999 
C 

C  IF  NOT  FOUND  DUCTING  LAYER  DO  NOT  PROCESS,  TEST  FLAG 
IF( ISTA,EQ.O)GeT9149a 
C 

C  LOOK  THROUGH  PROFILE  FROM  BOTTOM 

TO  TOP  for  MIN  IN  M  PROFILE 

INDl=IBOT+l 
IND2aIT0P^l 
DO  90  INDX=IND1, IND2 
IF (DATA (5^ INDX) .GE*O»O)GOT09O 
IF (data (5/ INDX+1 ) *LE«O.O)G0Te9O 
C 

C  Have  TOP  OF  LAYER,  SET  CONSTANTS 
XDTsDATAOi  INDX+1 ) 

XMT=DATA(4/ INDX+1 ) 

XDSsXDT 

XM2=XMT 

icnt=indx^ibot+i 

INDxXsINDX+l 
PI  «0*0 
C 

C  FIND  BOTTOM  AND  SUM  PHASE  INTEGRAL 
DO  91  1X1=1, ICNT 
INDXXsINDXX-1 
XDUDATAO,  INDXX) 

XM1;0ATA(4, INOXX) 

IF( XMTtGT»XM2»0R.XMT.LT.XMl )G0TO61 
XD1pXD2-(XD2-XD1 )« (XM2^XMT)/(XM2-XM1 ) 

XMlsXMT 

61  S= ( XM2-XM1 ) /(XD2-XD1 ) 

X1  =  SQRT(  (XM1-XMT+.0C1»S»(XD2-XD1)  )^^  +  3) 

X2=SQRT( (XMl-XMT)**3) 

PIkPI+.942809+(X1-X2)/S 
IF(XD1»LE*O.O)G0TO92 
IF(XM1-XMT.EQ»O.O)GOT092 
XD2=XD1 
XM2=XM1 
91  continue 
G0TB90 
C 
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C  FOUND  A  LAYER 
92  C8NTINUE 
XDB«XD1 
XMBsXMl 

FREQZ'!(1»0/(4»0*PI  )  )  *300*0 
IF(XDB.LT*10.0)FRE0Z«(3.0/(8.0*PI ) ) *300*0 
IF(FREQZ*GT.FRQ)G0T067 
FRQ=FREQZ 
ht*xdb 
c 

C  flag  S  duct  as  -1  IN  XDB  -  GRADIENT  AT  SURFACE 

C  FLAG  ES  DUCT  AS  -2  IN  XDB  +  GRADIENT  AT  SURFACE 

67  IF(XDB.NE*O.O)G0T097 
XDBs-l 

IF (DATA (5# IB0T) .GT*0*0)XDB»-2 
C 

c  increment  counters 

97  CALL  0UTX(2/XDB^FREQZ/LAT#LOG) 

90  continue 
C 

C  if  want  T0  print  heading,  min  FREQ 

AND  height  remove  c  from 
C  following  CARDS 

WRITE (6,201 )( 1ST ( ISTA, I ), I«l/A), 

( INPUT( I), Is3/5),FRQ,HT 
201  F0RMAT(7A6/2F9.2) 

IF  WANT  TO  PRINT  PROFILE  REMOVE  C  FROM  FOLLOWING  CAROS 
PRES  ten  dew  HGT  M  M  QRAD 
DO  140  Ksl,250 
Pls(551-K)*2 
P2»(25l-K)*2 

140  write (6, 141) PI, (DATA( I,K), Isl, 

5),P2,  (DATA(  I,K+250)  W*l,5) 

C  141  FORMAT (6F9. 2, 5X,6F9#2) 

C 

C  WRITE  ON  UNIT  11  (BIN) 

C  1ST  write  STAT  NUM,  LAT,  LOG/  EL, 

HR,  DAY,  MONTHS  BOTTOM,  TOP 
C  2ND  write  profile  OF  TEM,  DEW,  HGT,  M 
C  3RD  write  min  TRAPPING  FREQ  AND  HGT 
1492  WRITE(II)  INPUT(2)/ ( INPUT( I )/ 1-6/ 

8),  (  INPUT!  I  ),  U3,5),  IBOT,  ITQP 
WRITE! 11 )  ( (DATA! I,K), I«1,4),K«1,500) 

WRITE(II)  FRQ,HT 

RETURN 

END 

$IBFTC  OUTZ  NODECK 

SUBROUTINE  0UTX(UFLAG, HGT, FREQ, LAT, LOG) 
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CeriMGN  /X/  M8N(  13)  WNUM/ IAREA(5/ 

4)^ INUMX/ I  SUM (A/4^99)i 131(300/30)/ 

INUMST/ IXXI 

dimension  JDATA(4/4,/30) 

UDATAd/U^K)  I  -  GEOGRAPHIC  AREA 

v,  J  -  1  FREQ  FOR  S  DUCT 

J  -  3  FREQ  FOR  ES  DUCT 
U  «•  3  FREQ  FOR  E  DUCT 
J  -  4  HGT  FOR  E  DUCT 
K  «  COUNTER  DISTRIBUTION 

IF( JFUAQ»GT.3)G8T01O3 
GOTOdOl/lOS)^  JFLAG 

ZERO  Out  area  array 
101  DO  301  1*1/ INUMX 
DO  201  Usl>4 
DO  201  K=l/30 
201  JDATA(  I/U/K)=:0 
RETURN 

increment  COUNTERS 


I  FREQ 

DEL 

50 

0  -  999 

DEL 

1000 

1000  -  10000 

IHQT 

DEL 

200 

0  -  6000 

102  IF(HGT.LT.O.0)G0T0301 

C 

C  ELEVATED  DUCTS 

IFREQ=FREQ/50*0+1 .0 
IF( IFREQ.LE.20)GeT0502 
IFReQ'BO'O+FREQ/IOOO'O 
IF( IFREQ.GT»30) IFrEQ=30 

502  IHGT=HGT/200. 0+1.0 

IF( IHGT.GT.30) IHGT*30 

DO  204  I=ldNUMX 

IF( IAREA( I/l) .EQ.999999)GeT02O3 

IF(LAT.LT» IAREA( 1/ 1 ) .OR.LAT.GT. IAREA( 1/2) )GOT02O4 
IF (lOG.lt . IAREA( 1/3) .OR.LOG.GT. I  AREA ( 1/4) )Q0T02O4 

203  UDATAI 1/3/ I  FREQ ) =UDaT A ( I / 3/ IFREQ)  +  1 
UDATA( 1/4/ IHGT)sJDATA( 1,4/ IHGT)+1 

204  continue 
RETURN 

C 

c  surface  or  elevated  surface  ducts 

301  ITYPE*ABS(HGT) 

IFREQ=FREQ/50. 0+1.0 
IF( lFREQ.LE.2O)G0Te3O2 
I FREQ=20.0+FREQ/ 1000*0 
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IF( IFREQ.GT.30) IFREQ=30 

302  Oe  30^  I»1/INUMX 

IF(  I AREA{Iil)»EQ •999999)06.10303 

IF(UAT.LT*IAREAU#1) •8R.LAT.GT«IAREA( 1/2) )G6Te304 
IF(ueQ»LT» IAREA( 1/3) .OR.U0G,GT. IAREA( 1/4) )G8T8304 

303  JDATA( 1/ I  TYPE/ IFREQ ) * JDATA ( I / I  TYPE/ IFREQ)  +  1 

304  CONTINUE 
RETURN 

C 

C  OUTPUT  HEIGHT  AND  FREQUENCY  DATA 
103  IM0n«JFUAG-900 
write (6/ 209) 

209  FORMAT! 1H1////61H  OUTPUT  8F  HEIGHT 

AND  frequency  DISTRIBUTIONS  F8R 
1  GIVEN  AREAS) 

08  208  I=1/INUMX 
C 

C  normalize  frequency  DISTRIBUTION 
DO  706  J=l/3 
DO  706  K=21/30 
IF(UDATA( I/U/K) .EQ‘0)GeT8706 
J0ATA( I/U/K)*JDATA! I/U/K)/20+l 
706  CONTINUE 
C 

C  ON  PRINTER 

WRITE (6/ 205) I  MON/ ( I  AREA ( I  /  J ) / Us  1  /  4 ) 
a05  F0RMAT(////35H  MONTH  UATl 

LAT2  LOGl  LBG2///5I7) 

WRITE(6/206) ( J0ATA( I/l/K)/K=l/30) 

206  F0RmaT(//1OH  S  FREQ  /30I4) 
write (6/207 ) (JDATA! I/2/K)/Ksl/ 30) 

207  format (lOH  ES  FREQ  #3014) 

WRITE (6/ 246) ( JDATA( I / 3/ K ) / K* 1 / 30 ) 

246  FORMATdOH  EL  FREQ  /30I4) 
write (6/ 247) (UDATA( I/4/K)/Ks 1/30) 

247  FORMATdOH  EL  HGT  /30I4) 

C 

C  ON  UNIT  la  TO  BE  PRINTED  OR  PUNCHED 
ICNTsl 

WRlT£d2/212)  ICNT/  1/  IM0N/  (  I  AREA  (  I  /  U )  /  J=  1  /  4  ) 

212  F8RMAT(3I2/4I6) 

00  208  U=l/A 
IX2s0 

DO  208  Ksl/2 
ICNT=ICNT+1 
IXlsIXE+l 
1X2=1X1+14 

208  write (12/ 211) ICNT/ 1/ IHQN/ ( JDATA ( I / J/ L ) / L* I XI/  I  X2 > 
211  F8RMAT(3I2/ 1514) 
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RETURN 

END 

$IBFTC  OUT  N6DECK 

C  SUBROUTINE  TO  OUTPUT  DATA  AFTER  EACH  MONTH  IS-  PROCESSED 
C  IMON/  MONTH  OUTPUTING 

C  UNIT  6  -  LISTING  UNIT  12  -  PUNCH  CARDS 

C 

SUBROUTINE  OUTPUT! IMON) 
common  /X/  MON(  13)^  INUMWAREA(5/ 

h)^  INUMXi I  SUM (4> 4/ 99)/ I  ST (200/ 30)/ 

INUMST/ IXXI 
dimension  IXKX(5) 

DATA  IMAK/6H  99999/ 

C 

C  COMPUTE  AVG  SURFACE  MEASUREMENTS  FOR  EACH  STATION 
DO  8104  Isl/NUMST 
DO  8104  J=8/10 

8104  IST(I/J)-IST(I/J)/I3T(I/7) 

C 

C  OUTPUT  STATISTICS  FOR  EACH  STATION 

IN  INCREASING  STATION  NUMBER  ORDER 
C 

wRlTE( 12/8001 ) 

8001  FORMAT (//////23HM0NTHLY  STATION  SUMMARY) 

WRITE{6/ 11 )NUMST/ IXXI 

11  FORMAT! 1H1/////24H  MONTHLY  STATION  SUMMARY/IOX/ 

115H  STATION  COUNT  /I3/5X/21H  NUMBER 
OF  SOUNDINGS  / 14//) 

DO  8103  UJI I =1/NUMST 
IMIN=IST(1/1) 

1=1 

DO  8105  JJ?2/NUMST 

IF! 1ST! JJ/ 1 ) .LE« IMINIGOTOSIOB 

IMIn=IST!JJ/1) 

I=JJ 

8105  continue 

WRITE(6/176) IMON/ ! I  ST ! I / J ) / U* I  /  30 ) 

176  FORMAT! 1 3/4! IX/ A6)/6! IX/ 16)/ 10! IX/ 13 ) / // 73X/ 10 ! IX/  13) ) 
WRITE (12/ 178) IMON/ ! I  ST ( I / J ) / Js 1 / 10 ) / I  MON/ I  ST ! I / 1 ) / 

1 ! 1ST! 1/ J)/ J=ll/30) 

178  F8RMAT!2H  1/ I2/4A6/ 616/// BH  2/ 1 2/ A6/ 20 1 3 ) 

8103  IST(I/1)=IMAK 

OUTPUT  STATISTICS  FOR  EACH  GEOGRAPHICAL  AREA 

WRITE! 12/8002) 

8002  F0RMAT!//////23HCHARACTERISTICS  BY  AREA) 

DO  98  I J=l/ INUMX 

C 
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C  calculate  the  T8TAL  NUMBER  SF  LAYERS  F0R  EACH  DIVISION 
00  4030  1=1/5 

4030  IXKX(I)=0 

00  4032  1=1/4 
00  4031  U=52/74 

4031  IXKX( I ).IXKX( I )+ISUM(IJ,I/ J) 

4032  IXKX(5)sIXKX(5)-t.IXKX(  I  ) 

IWXX=1 

WRITE(6/2) IM0N> ( I  area ( I J/ J)^ Jsl/4)/ IXKX(5) 

2  F0RMAT(1H1/////25H  CHARACTERISTICS 
BY  AREA///7H  M0nTH/3X^ 

14HLAT1/3X/4HLAT2/3X/4HL0G1/3X/4HLOG2///5( IX/ I6)/5X/ 
222HT0TAL  NUMBER  0F  LAYERS/ 15) 
write (12/ 12) I WXX/  IJ/  IM0N/ ( I  AREA ( I J/ U )  /  U= 1  /  4 ) 

12  F0RMAT(3ia/4l6) 

00  98  KK»l/4 

ixa^so 

00  198  KKK=l/6 

IWXXsIWXX+1 

IXl. 1X2+1 

1X2=1X1+16 

IF( IX2.GT«99) 1X2=99 

198  write (12/ 14) I WXX/  lU/ IM8N/ ( I  SUM ( I KK/ I K ) / I K= I XI / I X2 ) 
14  F0RMAT(3I2/ 1714) 

Q0T8( 610/611/612/ 613 )/KK 

610  WRITE(6/1610)IXKX(1) 

1610  F8RHAT(//18H  gradients  LT  -150/ 

22X/16HNUMBER  OF  LAYERS/ 15) 

G0T698 

611  WRITE(6/1611)IXKX(2) 

1611  FeRMAT(//30H  GRADIENTS  GE  «-l50/ 

AND  LE  -75/ IIX/ 16HNUMBER  8F  LAYERS 

1/  15) 

GeT898 

612  WRITE(6/1612) IXKX(3) 

1612  F6RMAT(//28H  GRADIENTS  GE  75/ 

AND  LE  150/ 13X/ 16HNUMBER  8F  LAYERS/ 

115) 

GeTQ98 

613  WRITE(6/ 1613) IXKX(4) 

1613  FeRMAT(//17H  GRADIENTS  GT  150/ 

23X/ 16HNUMBER  0F  LAYERS/ 15) 

98  write (6/ 702) ( ISUM( lU/KK/ IK)/ IK«l/99) 

702  F8RnaT(//4H  HGT/20(1X/I4)///AX/ 

20(1X/ I4)///4X/11(1X/ I4)///4H  THK/ 

120(1X/  U)///4X/3(1X/  I4)///4H  GRA/ 

20(1X/ I4)///4X/5{1X/ 14) ) 

C 

C  OUTPUT  FREQ  DATA  BY  AREA 


71 


QUACK 


PAGE  83 


WRlTE(12/8003) 

8003  F0RMAT(//////22HFREQUENCY  DATA  BY  AREA) 
IXMeN=IMaN+900 

CALL  6UTX(IXMeN^0./0*#0*/O. ) 

RETURN 

END 

$IBFTC  HGT  NODECK 

C  FUNCTION  heigh  COMPUTES  THE  HEIGHT  BETWEEN  TWO  SETS  OF 
C  MET0R0LQQICAL  DATA 
C 

FUNCT ION  HE  I GH ( P 1 / P2>  DEGl^  DEG2, DEWl / DE W2 ) 

DATA  A/ B/ C/25 » 0578498# -3009. 47384^ -5 *43916634/ 

RATiei?‘A+B/(DEWl+273.0)+C*ALeGl0<DEWl+a73.0) 

RATl02*A+B/(DEWa+273»0)+C*AL6GlO(DEW2+273.0) 

WM?:(  1O.O*»RATI01/P1  +  1O.O**RATIO2/P2)/2.O 
HEIGH-18400.0i^AL0G10(P1/P2) 
l»(1.0+( ( (DEGl+DEG2)/2.0)/273.0) ) / ( 1 . O-O. 378*WM ) 
RETURN 
END 

3>IBFTC  INDX  NODECK 

C  FUNCTION  XIND  COMPUTES  THE  REFRACTIVE 

INDEX  GIVEN  PRESSURE# 

C  temperature#  and  DEW  POINT 
C 

FUNCTION  XIND(P#TEM#DEW) 

data  a# B# C/25 » 0578498# - 3009 *4 7384# -5 » 439 16634/ 
RATl0*A+B/(DEW+273.0)+C*ALeG10(DEW+273.0) 

XIND- (77.6/(TEM+273.0) ) 

1»(P+(4810*0^'(10.0**RATI0)  )/(TEM  +  273.0)  ) 

RETURN 

END 


$ibmap 

help 

NODECK 

INPUT 

file 

#A(1)#BLK*316#BCD# DEFER 

KPUT 

file 

#A(2)#8LK=316#BCD#DEFER 

OPENl 

SAVE 

TSX 

.CLeSE#4 

PTW 

KPUT 

TSX 

.OPEN#  4 

PZE 

INPUT 

RETURN 

0PEN1 

opene 

SAVE 

TSX 

.CLGSE#4 

PTW 

INPUT 

TSX 

.OPEN# 4 

PZE 

KPUT 

return 

0PEN2 

IN 

SAVE 

CLA* 

5#4 

sxa 

A#4 
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tpl 

*  +  7 

TSx 

.READ/4 

Pit 

INPUT 

Pit 

EOF f  t  *-2 

I0RT 

BLOCK/ / ** 

UXD 

»-l/4 

tra 

*  +  6 

TSX 

.READ/ 4 

PZE 

KPUT 

PZE 

EOf"  /  /  *'^2 

I8RT 

BLOCK/ / ** 

LXD 

»-l/4 

pxa 

/4 

A 

AXT 

»*/  4 

STe^^ 

3/4 

STZ^^ 

4/  4 

return 

IN 

EOF 

XEC 

A 

CLA 

=  1 

ST8* 

4/4 

RETURN 

IN 

CONTRL 

// 

BLOCK 

COMMON 

END 

316 

$IBMAP 

DECODE 

NODECK 

DECODE 

SAVE 

2/1/  I 

CAL 

4/  4 

ADD 

*5760 

STA 

STORE 

CAL^* 

5/  4 

STA 

*•+3 

ADO 

3/4 

STA 

LMQ 

AXT 

**/  4 

AXT 

5760/2 

L0OP2 

AXT 

6/1 

LMQ 

LDO 

**  f  4 

LOOPl 

CLA 

=  0 

LGL 

6 

STORE 

STO 

*•* /  2 

TXJ 

»+!/ 2/ ^ 1 

TlX 

LOOPl/ 1/ 1 

TlX 

L0OP2/4/ 1 

s-oata  » 

RETURN 

END 

DECODE 
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MAP 

$USE  BLKPAR(ZPARAN)/BLKPAR(ZPARAM) 

$USE  8LKTAP{ZTPDNN)/BLKTAP{ZTPDNT)^BLKTAP(ZTPDHL) 

$USE  BLKTAP ( ZNFPL ) ^  BLKTAP ( ZTPDMP ) 

s^USE  XBLKS(ZHEIQH)/XBLKS{PAT0UT)/ 

XBLKS (I NPT ) / XBLKS ( ZT AB ) 

$USE  XBLKS ( ZU INE ) , X8LKS | WEjeUT ) / XBLKS { REFaUT ) 

$IBFTC  XBlKS  DECK 

C  BL0CK  DATA  T8  ENSURE  THAT  CeMMONS 

ALL  HAVE  PRePER  SIZE. 

Block  data 

CeMMON  /ZHEISH/  HEIGHT(5) 

C0MM0N  /PATOUT/  PATIIO) 

COMMON  /INPT/  YINPTdS) 

C0MM0N  /ZTAB/  TaB(402) 

CeMMON  /ZLINE/  LINE(200) 
common  /WETBUT/  WET(4) 
common  /REFOUT/  REF(6) 

END 

$IBFTC  BLKTAP  DECK 

BLOCK  DATA 

C  TAPE  DESCRIPTION 

COMMON  /ZTPDNN/  NM I SS/ NAMES ( 20 ) 
common  /ZTPDNT/NTMPER(2C) 

COMMON  /ZTPDMP/MAPT{13) 

COMMON  /ZTPDHL/ISPEC(2/20) 

common  /znfpl/nfpl 

DATA  NMISS/ (NAMESU  /14/ 

1  6HCAR001/6HCAR002/6HCAR003/6HCAR004/ 

6HCAR005/6HCAR006>6HCAROC)7/ 

2  6HCAR008/ 6HCAR009> 6HCAR0 J 0/ 6HCAR0U / 

6HCAR012/6HCAR013/6HCAR014/ 
data  (NTMPERI  I  )/ I  =  ld4)  /14*1/ 

DATA(  (ISPECI  d  I^d2)>  J  =  li  14)  / 

X  SjSj  15/18j  10/15>  14>l7/  12/ 

16/  12/16/  13/16/  9/12/  6/7/ 

X  11/12/  16/18/  2/6/  8/10/  6/10  / 

data  (MAPT( I ) / l5l/ 13)  /1/2/3/4/5/6/8/7/9/ 10/ 11/2/ 12/ 
DATA  NFPL  /12/ 

END 
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$IBFTC  XAIDA  DECK 

C  aircraft  data  reduction  driver  PROGRAM/  repcol-input 
C 

SUBROUTINE  AIDA 

common  /znflt/nflt 

COMMON  /ZPARAM/DUM(a5)/PR8CS/DUMP 
COMMON  /INPT/PAR/UST 
UOGICAU  PROCS 
LOGICAL  DUMP 
LOGICAL  PAR 
LOGICAL  LST 
1  FORMAT ( IHI ) 

NFLT  =  0 

100  NFLT  5  NFLT+1 
CALL  PINTl 
CALL  POUTl 

IF(OUMP)  WRITE(6/  1) 

150  CALL  INPUT 

IF  (PROCS)  CALL  REFCOL 
IF  (.NOT. LST)  GO  TO  150 
GO  TO  100 
END 
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SIBFTC  XPINTI  PECK 

SUBROUTINE  PINTl 

C  this  SUBROUTINE  INPUTS  THE  PARAMETERS  CARDS 
C  IT  ASSIGNS  THE  VALUE  OF  THE  PARAMETER 

ACCORDING  TO  THE  TYPE 
C  the  name  of  the  PARAMETER  ISS  USED 

TO  FIND  THE  TYPE  AND  OFFSET 
C  IN  THE  TABLE  PARAN* 

C 

COMMON  /ZPARAN/  NPAR/  PARAN(2n) 
common  /ZPARAM/  PARAM(l) 

INTEGER  PARANA  ALPH^COMdO)/  iPARAMd  ) 

INTEGER  STPdR/FAL 
LOGICAL  LPARAMd) 

EQUIVALENCE  (  PARAMd  )dPARAMd  )  APARAM(  1 )  ) 

DATA  NDiTR/FAL  /5H*END*dHT/ IHF/ 

DATA  STP/6H»ST0P*  / 

WRlTE(6/90a) 

100  READ(5^900)  ALPH/VAL/CoM 
WRITE(6/901)  ALPHiVAL#CQM 

if(alph  .eq»  nd)  return 
IF(  alph  .eq.  stp)  stop 

DO  150  I  =  dNPAR 
IX=I 

IF(ALPH  .eg*  PARANdd))  GO  TO  200 
150  continue 

WRITE(6#903) 

GO  TO  100 
200  N=PARAN(2/ IX) 

GO  10(300/350/400/450/500)/  N 
C  DO  ASSIGNMENT  ACCORDING  TO  THE  TYPE  OF  PARAMETER 
C 

C  FLOATING  POINT  PARAMETER 
300  PARAMdX)»VAL 
GO  TO  100 

C  FIXED  POINT  PARAMETER 
350  IPARAMdX)  sVAL 
GO  TO  100 

C  LOGICAL  PARAMETER 

400  IF(COMd)  .EQ.  TR)  LPARAM(  IX)  =  .TRUE. 

IF(C0Md)  .EQ.  FAD  LPARAMdX)s.FALSE. 

IF(  C0Md).NE.TR  .AND.  C0Md).NE.FAL  )  WRITE(6/904) 
GO  TO  100 

C  ALPHANUMERIC  PARAMETER 
450  IPARAMdX)  »COMd  ) 

GO  TO  100 
C  TIME  PARAMERER 
500  ITIME-VAL 

IHRaITIME/10000 
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IMIN=  MOD  (ITIME/100/100) 

ISEC  «  MOD  ( ITIME^OO) 

PARaM( lX)»ISEC+60»( IMIN+60*IHR) 

GO  TO  100 

900  FQRMAT(A6#2X/F10»0^ 10A6) 

901  format (1 X/A6/2X#Ei5» 5/ lXilOA6) 

902  F0RMAT(1H1^1X,4HNAME/1AX/5HVAUUE/7X,8HC0MMENTS  ) 

903  F9RMATI33H  UNRECOGNIZED  NAME.  CARD  IGNORED.  ) 

904  F6RMAT(29H  ILLEGAL  VALUE*  CARD  IGNORED.) 

END 
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$IBFTC  XHGT  DECK 

C  height  BEEBE  +  SULLIVAN  a.J 

SUBROUTINE  HEIGHT! I) 

I  GE  1  IF  NOT  FIRST  TINE  THROUGH  ROUTINE  FOR  A  SPIRAL 
RADIUS  =  RADIUS  OF  EARTH 

ZS  =  height  of  reference  SURFACE  ABOVE  SEA  LEVEL 
PR  P  PRESSURE^  FN  «  REFRACTIVE 

INDEX^  FKF  e  TEMPERATURE/EF  *  VAPOR 
C  Z  =  GE0P0TENTIAL  HEIGHT^  R  «  SEMIMINOR 

AXIS/A=  SEMIMAJOR  AXIS 

common  /ZPARAM/ZS/DUM(21),RADIUS#R/A^DUMa(30) jZOFSI 
COMMON  /ZHEIGH/FN/EF/Z^RH0/RMF 
common  /PATOUT/PR/DUMl (5)iFKF 
IF  (i.GE.j)  GO  Ten 
Z  *  ZOFSl  +  ZS 

FKSl  p  FKF*(1*0  +  0.388  *  EF/PR) 

GO  T0  H 

1  FKS2  -  FKF*(1.0  +  0.388  EF/PR) 

VAL  =  AL0G  (OLDPR  /  PR) 

DELPSI  »  14.645  *  (FKSl  +  FKS2 )  «  VAL 
DELZ  -  DELPSI  *(R/A)  *  (1.0  + 

2.0  *  Z8LD  /  R  +  DELPSI  /  A  ) 

Z  s  Z0LD  +  DELZ 
FKSl  -  FKS2 

2  RHO  s  Z  /  RADIUS 

RMF  s  Fn*(1.0  +  RHe)*0. 000001  +  RH0 

Z0LD  <=  Z 

OLDPR  p  PR 

RETURN 

END 
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$IBFTC  XINPUT  DECK 
C 

SUBR0UTINE  INPUT 
C  INPUT  ceMMeNS 

C9NNeN  /ZNFLT/NFLT 

CeMM9N  /ZPARAN/DUM(^7)/MISID^TSTART/TSTeP 


C  TAPE  DESCRIPTIBN  C0MMDNS 

COMN0N  /ZTPDNN/NMlSSiNAMES( 1) 

1  /ZTPDMP/NAPT(13) 

C  OUTPUT  COMMON 

common  /INPT/PAR/LST/X(13) 

C  communication  with  teWER  SUBROUTINES 
COMMON  /ZFLTIM/IHli IMl/ ISl/ IHE^ IMBi 
common  /ZNWMIS/NWMIS 

1  /ZMISSR/MISSR 

2  /ZTAB/P/N#TAB( J  ) 

3  /ZRTIME/RTIME 

4  /ZLINE/LINEd) 

common  /zcerr/cerr 

LOGICAL  NWMIS/EOM^P/PAR/LST/MSL 
logical  CERR 

LOGICAL  LOGCOM 
DATA  LFLTAMIS  /OiO/ 

c  formats 

1  F0RMAT(46H  NO  SUCH  MISSION  ID 

ON  TAPE  -  flight  ignored.  ) 

^  F0RMAT(48H  MISSION  REQUESTS  OUT 

OF  SORT  -  flight  IGNORED.  ) 

c  IS  THIS  A  NEW  Flight 

IF  (NFLT  .EQ.  LFLT)  go  to  1000 
LFLT  *  NFLT 

C  YES,  INITIALIZE  IF  NFLT  »  1 

IF  (NFLT  •NE*  1)  GO  TO  105 
NWMIS  -  .TRUE. 

MISNO  =  1 

C  FIND  NO.  OF  REQUESTED  MISSION 
105  ISPTS  =  1 

DO  110  MISS»1#NMISS 
MISSR’MISS 

IF(MISID  .eg.  NAMES(MISSR) )  GO  TO  120 
110  ISPtS  »  ISPTS+NTMPER(MISSR) 

C  CaNNOt  find  mission  with  proper  id 

WRITE(6/1) 

GO  TO  2010 

C  IS  the  mission  the  same  as  the  last  (ERROR  IF  LESS) 
120  IF  (MISSR  .GE.  LMIS)  GO  TO  130 
WRITE (6, 2) 

GO  TO  2010 

130  MSL  «  MISSR  .EQ.  LMIS 


/ZTPDNT/NTMPER( 1 ) 
/ZTPDHL/ISPEC(2,1 ) 


IS2 

/zmisno/misno 

/ZISPTR/ISPTR 

/ZEOM/EOM 

/ZIREL/IREL 
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IF  (NSL)  GO  T8  200 
LMIS  =MISSR 

C  update  MISSI8N-ASS0C.  CSNSTANTS 
ISPtR  =  ISPTS 
IREL  s  iSPECd,  ISPTR) 

C  IF  THE  tape  has  to  BE  MeVED,  MOVE 

IT  AND  UPDATE  PHYSICAL  TAPE 
C  POSITION  indicators 
NHS  *  HISSR-filSNO 
E8M  =  .FALSE. 

IF  (NHS  .LE.  0)  GO  TO  200 
DO  150  I  s  J/NMS 
145  CALL  SFDATP 
CALL  RDATP 

IF  (N  tNE.  0)  GO  TO  145 
150  CONTINUE 

MISNO  «  MISSR 

NWniS  »  .TRUE. 

C  UPDATE  flight  constants 
200  IHl  =  TSTART/3600. 

IMl  »  AMeD(TSTART/3600« )/60. 

151  »:  AMeD(TSTART/60t  ) 

IH2  =  TSTOP/3600* 

IM2  =  AM0D{TSTeP/360O. )/60» 

152  ?  AM00(TSTeP/60. ) 

IHIR  s  MeD(IHl+24-IREL/24) 

IH2R  *  MeD( IH2+24-IREL/24) 

RQRST  =  3600*IH1R  +  60*1^1  +  ISl 

RQRET  =  3600*IH2R  +  60#lM2  +  IS2 

C  IF  SAME  MISSION#  SKIP  1ST  READ 
IF  (MSL)  GO  TO  310 
C  FIND  FIRST  LINE 
300  CALL  RDLINE 
310  IF  (EOM)  GO  TO  2010 

IF  (RTIME  .LT.  RQRST)  60  TO  300 
C  OUTPUT  A  LINE 
1000  PAR  =  CERR 

X(l)  AMQD(RTIME  +  3600.^^FLeAT(  IREL)/86400.  ) 

DO  iiOO  I  =  2#i3 

K1  »  4»(MAPT( I )-l )  +  1 

K4  =  Kl+3 

DO  1010  J  s  K1/K4 

IF  (LINE(J)  .GT.  9)  GO  TO  1030 

1010  continue 

X(I)  =  1000^'LINE(K1)  +  100<^LINE{K1  + 

1  )  +  10'^LlNE(Kl+2)+LINE(Kl  +  3) 

GO  TO  1100 
1020  PAR  »  .TRUE. 

1100  continue 
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c  read  anew 

CALL  RDLINE 

LST  s  E8M  .OR.  RTIME.GT.RQRET 
RETURN 

C  FAILURE  EXIT 
aolo  DO  2020  I  =  1#13 

2020  X( I )  s  0. 

PAR  =  .TRUE. 

LST  »  .TRUE. 

RETURN 

END 
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C  ROUTINE  COMPUTES  PRESSURE, AJR  SPEED  AND  TEMPERATURE 
SUBROUTINE  PAT 

common  /INPT/  P,L,XTIME,XRl,XR2, 

XR3,XALT,XEVENT-»XSPEED,XPReS,XKS4T 
1,XEKT,XRH,XR4,XVXT 
COMMON  /ZPARAM/  ZS, RFSl , RF Vl , RNMl , 

RKPl/ ANDFI, ANWFl, ACMRVP, 

1  CdRMR,CORVP,C0RlN/ ITPROB, IHUM, 

I RSCT, PUNCH, KPAR, BETA!, betas, 

BET A3,  BETAA, betas,  ALPHA, RAD lUS, R, A, PROCS, DUMP, 

pvmin,pvmax,pmin,pmax,svmin,svmax, 

SMIN,SMAX,T4VMIN,T4VMAX, 

4T4MIN,T4MAX, 

5  EKVMIN,EKVMAX,,EKMIN,EKMAX,VXVMIN,  VXVMAX,  vxmin,vxmax, 
6MISSID,TSTART,TST0P,CPRES,CSPEED, 

CKS4T,CEKT,CVXT,Z0FS1,CHKFC 
common  /PATOUT/  PRES, speed, S,TKS4, 

TEK,TVTX,FKF,TF,PTEMP,FNdF 
TLIN(X,A,B,Y,Z)  ?  ( X-A  )  »  (  Z-Y  )  /  { B-A ) 

T73  s  273,16 
ONE  e  1.0 
DPDN  =  1» 

PMK4  =  TLIN{XPRES,PVMIN,PVMAX,PMIN,PMaX)  +  CPRES 
PRES  *  PMK4  +  DPDN 

SPEED  TLIN(XSPEED,SVMIN,SVMAX,SMIN,SMAX)  cspeed 
S  5  SPEED*»2/PRES 

TKS4  =  TLIN(XKS4T,T4VMIN,T4VMAX,T4MIN,T4MAX)  +  CKS4T 
TEK  =  TLINiXEKT,EKVMIN,EKVMAX,EKMIN,EKMAX)  +  CEKT 
TVTX  s  TLIN(XVXT,VXVMIN,VXVMAX, VXMIN,VXMAX)  +  CVXT 
GO  TO  (1,2,3) , ITPRQB 

1  FKF  P  (TKS4  +  T73  )/(eNE+  BETAl  *  S) 

GO  TO  4 

2  FKF  p  (TEK  +  T73  )/(ONE+  BETAS  »  S) 

GO  TO  4 

3  FKF  =  (TVTX  T73)/(0NE  +  BETAS  *  S) 

4  TF  p  FKF  -  T73 
IF  (PRES)  5,5,6 

5  PTEMP  =  0. 

GO  TO  7 

6  PTEMP  s  FKF^'(1000.0/PRES)**(2»/7.  )  -  T73 

7  FNDF  P  77,6->iPRES/FKF 
RETURN 
END 
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$IBFTC  XP0UT1  DECK 

c  parameter  print  I 
c 


1 

2 


10 


SUBR0UTINE  PeUTl 

C0MM8N  /ZPARAN/NPAR/PARAN(2,1) 

INTEGER  PARAN 

DIMENSION  NAMES(5)/VAUUES(5)/F0RMS(3/ 
5)4  ITIM{15)^F8RM(3) 
equivalence  ( ITIM4 VALUES) 


/zparam/param( j ) 


DATA  F0RMS{1/1) 

DATA  F0RMS(l42) 
lOX)  ) 

DATA  FeRMSd/S) 
lOX)  ) 

data  FORMSd/A) 

8X)  ) 

DATA  FeRMSd45) 

2(1H»I2)7X) ) 


/24H{5dXF19, 

/ 

/24H(5dXI94 

/ 

/24H(5(9XH4 

/ 

/24H(5(6XA64 

/ 

/24H(5d64 

/ 


9)  ) 


F0RMATdHl/50X428H«  CURRENT  PARAMETER  VALUES 
F0RMAT(/5dX4lH#4  5X/A64  6X4lH*)  ) 

WRlTE(64l) 

D0  100  ITYPE  ?  1/5 

NVAL  -  0 

D0  10  I  =  1/3 

F0RMd)  '  FORMSd/ ITYPE) 

D0  99  I  »  1/NPAR 

IF  (  ITYPE.NE*PARAN(2/ I ) )  GO  TO  80 
NVAL  =  NVAL  +  1 


NAMES(NVAL)  ='PARANd/I) 

IF  (ITYPE  ♦EQ»  5)  GO  TO  30 
VALUES(NVAL)  p  PARAMCI) 

Q0  TO  80 
30  V  p  PARAM( I ) 

NT  =  3*NVAL-2 
ITIM(NT)  *  V/3600. 

ITIM(NT  +  1)  »  AM8D(V/36000/60. 

ITIM(NT+2)  »  AM0D(V/60.) 

80  IF  (.NOT. (NVAL  .EQ.  5  .OR.  (I 

.EQ.  NPAR  .AND.  NVAL  .GT.  0))) 
1  GO  TO  99 

WRITE(642)  (NAMES( J)/ J«1/NVAL) 

IF  (ITYPE  .EQ.  5)  -NVAL  -  3*NVAL 
WRITE (6/ FORM)  ( ITIM( J)/ jal^NVAL) 

NVAL  -  0 
99  continue 

100  continue 

RETURN 

END 
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C 

C 


READ  A  LINE  8F  PAPER  TAPE  DATA 

SUBR6UTINE  RDUINE 
C0MMeN/ZTPDHL/ISPEC(2W ) 


/ZZdn/EQ^ 


1  /ZLINE/LINE(200) 

2  /ZRTIME/RTIME 

4  /zirel/irel 

5  /ZMISSR/MISSR 
C0MM0N  /ZMISN0/  MISN0 

common  /ZPARAM/DUMl ( 26 ) / DUMP, DUM2 ( 29 ) , CHKFC 
COMMON  /ZNFPL/NFPL 
COMMON  /ZCERR/CERR 
DIMENSION  CLIST(12)/CHAR(200) 

LOGICAL  EOM/DUMP 
LOGICAU  CHKFC/CERR 
DATA  (CLIST{I),I«1,12) 

1H2, lH3i 1H4/ 1H5/ 1H6, 1H7# IHS, 1H9, 

X  IHtilH*  / 

DATA  LMIS  /O/ 

1  format  (26(1X,4A1)/(5X,120A1) ) 

IF  (MISSR  .EO.  LMIS)  GO  TO  200 
INITIALIZATION  EACH  MISSION 
LMIS  *  MISSR 
KK  p  0 

KIT  1=  4*(MAPT(1)-1)  +  1 
KRH  p  0 
PTL  s  0. 

ITSPH  p  MODdSPECtS,  ISPTR)+24-lREL/24) 

LEGnC  «  4*NFPL  +  J 
200  DO  299  I  »  J/200 
KK  ;=  KK  +  1 
KR  5  KHaR(KK) 

IF(EOM)  go  to  400 
L I NE  (.1  )  *  Kf^ 

CHAR( I )  =  CLIST{KR+J ) 

IF  (KR  .EQ.  10)  GO  TO  400 

299  continue 
I  =  200 

300  KK  *  KK+1 

KR  a  KHAR(KK) 

IF(E0M)  go  to  400 

IF  (KR  .NE.  10)  GO  TO  300 

eol  character  reached 

400  IF(DUMP)  WRITE(6/1)  (CHAR( J) ^ J*!, I ) 

IF(E0M)  MISN0=MISN0+1 
IF  (EOM)  RETURN 

CERR=  (CHKFC  .AND.  I  .NE.  LEGNC)  .OR. 

1  LINE(K1T  )  .GT.  5  .OR.  LINE(K1T+1)  .GT. 

2  LlNE(KlT+2)  .GT.  5  .OR.  LlNE(KlT+3)  .GT. 


/ZISPTR/ISPTR 
/ZTPDMP/MAPT( 1 ) 


.OR. 
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IF  (.NQT.  CERR)  G0  TQ  450 
PT  s:  PTU 
G0  JQ  500 

450  PT  60*(l0*LINE(KlT)+LlNE(Kn4 

1)>  +  lO*UINE(KlT+2)  +  LINE(K1T+3) 
IF  (PT  .QE-  PTL)  G8  T0  500 
KRH  s  KRH+1 

IF  (KRH  »tE.  ITSPH)  G0  T0  500 
ISPtR  =  ISPTR+1 

KRH  -  M0D( ISPeC( li ISPTR)+24-IREL/24) 

ITSPH  ?=  M8D(  ISPEC(2/ ISPTR)+24-IREL^24) 

500  RTIME  =  3600.*FL0AT(KRH)  +  PT 
PTU  =  PT 
RETURN 
END 
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SUBROUTINE  REFCOL 

common  /ADATA/  EH20(1000) 

common  /INPT/  PARAAST>XTIME/XR1> 

XR2/ XR3/ XALT#  XEVENT#  XSPEED, XPRES> 
1XKS4T/XEKT/XRH/XR4/XVXT 
common  /ZPARAM/  ZS/RFSl/RFVJ/RNMl, 
RKPIMNDFI^  ANWFl/ ACMRVP/ 
iCORMR/CORVP/CORIN/ ITPROBi IHUM/ 


I RSCT/ PUNCH/ KPAR/BETA1/BETA2/ BETAS/ 
2BETA4/BETA5/ALPHA/RADIUS/R/A/PRQCS/DUMP 


5 


1 


COMMON  /PAT0UT/  PRES/ SPEED/ S/ TKS4/ 

TEK/TVTX/FKF/TF/PTEMP/FNDF 
common  /WETOUT/  ARF/AEF/ANWF/ ANF 
COMMON  /REFOUT/  RDNM/RNM/RNWF/REF^RRF^RNF 
COMMON  /ZHEIGH/FNF/EF/Z/RHO/RMF 
dimension  MRDNG(50)/ZSPEED(50)/ 

ZPR(50)#ZTKS4(50)/ZTEK{50) 
dimension  ZTVTX(50)/ZDELN(50)/ 

ZN 1 50 ) / ZFNOF ( 50 ) #  ZFNWF ( 50 ) / ZT I  ME 
dimension  I IVENT(50)/ZFNF(50)/ 

ZPINDX(50)/ZZ(50)/ZALT(50)/ZPRES 
dimension  ZTF(50)/ZPTEMP(50)/ZMIXR(50)/ 
ZVAP0R(5O)/ZRMF(5O) 


dimension  IPAR(50) 
dimension  ZNF(50) 

LOGICAL  PAR/LAST/PUNCH 
LOGICAL  PROCS/DUMP 
INTEGER  ZTIME 
DATA  KOUNT/O/z 11/0/ 

DATA  ISTAR/IH*// IBLANK/IH  / 

IF  (KPAR)  5/5/1 

IF  {.NOT. PAR)  GO  TO  1 

IF  (LAST*AND. (II .GE.l ) )  GO  TO  501 

IF  (LAST)  GO  TO  520 

RETURN 

CALL  PAT 

CALL  WET 

IF  (RKPl)  2/2/3 


50) 

50) 


2  IHUM  p  1 

3  IF  (IHUM.EQ.l)  GO  TO  110 


GO  TO 

(50/ 

50/ 

>50/ 

55)/ IRSCT 

50 

IF  (RFSl) 

51/ 

>51/ 

60 

51 

IHUM 

-  1 

GO  TO 

110 

55 

IF  (RFVl) 

56i 

)  56/ 

60 

56 

IHUM 

=  1 

GO  TO 

110 

60 

CALL 

REFCT 

FNFs 

RNF 

87 


RAWCeN-.REFCBU^  PRSCESS  A  FLIGHT 


PAGE  R 


RFE  =  RRF 
EF  s  REF 
G8  TO  115 
110  FNF  =  ANF 
RF2  s  ARF 
EF  =  AEF 
RNM  p  Of 
RDNM  *=  0. 

RNKF  5=  0* 

115  CALL  HEIGHT(KeUNT) 

ZPRT  «  Z  -  ZS 

IF  (Z*LT-ACMRVP)  go  to  120 
FNF  s  FNF  +  CORIN 
RF2  s  RF2  +  CORMR 
EF  p  EF  +  CORVP 
120  ALT  p  If 499  *  XALT 
ITIME  =  XTIME 
ISEC  ?  MOD( ITIME^60) 

ITIMEI  '  ITINE/60 
IMIN  *  N8D( ITIME1#60) 

IHRS  =  ITIME/3600 

TIMEX  *  10000*IHRS  +  100*IMIN  +  ISEC 
IVENT  *  XEVENT/lOOf 
IF  (PRES)  200/200/201 

200  PINDEX  p  0. 

GO  TO  202 

201  PINDEX  p  FNF» (1000*/PRES)*#0*714 

202  KOUNT  =  K0UNT  +  1 

IF(PUNCH)  WRITEd/lO)  KOUNT/Z/ 

FNF/ RMF/TF/PTEMP/EF/ PRES/ RF8 

II  p  II  +  1 
MRDNG(II)p  KOUNT 

zspeeD(ii)  p  speed 

ZPR(II)  =  PRES  -  If 
ZTKS4( 1 1 ) ■ »  TKS4 
ZTEK(II)  p  TEK 
ZTVTX(IJ)p  TVTX 
ZDELN(II)p  RDNM 
ZN(II)p  RNM 
ZFNDFdl  )  p  FNDF 
ZFNWFdl)  =  RNWF 
ZTlMEdl)  p  TIMEX 
I  IVENT (I  I)  p  IVENT 
ZFNFdl)  =  FNF 
ZPiNDXdl)  =  PINDEX 
ZZd  I)  =  ZPRT 
ZALTdl)  p  ALT 
ZPRESdl)  p  PRES 
ZTFdl)  =  TF 
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X  4X5HVAP0R/8X1HI1) 

24  format (47X6HMETERS#5X6HMETERS# 

7X3HMB./5X5HDEG.C/4X5HDEG.Cf 4X 
X  5HRATI0/3X8HPRESSURE  ) 

25  F0RMAT(98X4HG/KG  /) 

26  format  (IHl) 

END 
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$I8Ftc  xrefct  deck 

SUBROUTINE  REFCT 

CBMHON  /INPT/  PAR^UAST/XTIME/XRI/ 

XR2^XR3/XALT/XEVENT#XSPEED,XPRES/ 
1XKS4T/XEKT/XRH^XR4;XVXT 
CQMNON  /ZPARAM/  ZS/RFSl/RFVl/RNMl, 

RKPl/ ANDF1,,ANWF1#  ACMRVP, 
ICORMR/CORVP/CORIN/ ITPR0B/ IHU^i 

IRSCT#PUNCH,KPAR,BETAliBETA2^BETA3> 
2BETA4/BETA5/AUPHA/RADIUS,R/A 
CeMMON  /PATGUT/  PRES^SPEED/S/TKS4# 

TEKiTVTX/FKF/TF-»PTEMP#FNDF 
common  /WETOUT/  ARF/AEF#ANWF/ANF 
common  /REFOUT/  RDNM,RNM,RNWFiREF,RRF,RKF 
CONI  «  1.0  +  (BETA5*S*1.4/.4) 

CONg  s  i.Q  +BETA5  *  S 

RKP  =  FKF  *  a.  +  BETA4  *  S) 

GO  TO  (l/2i3#4)/  IRSCT 

1  XXX  p  XRl 
GO  TO  5 

2  XXX  *  XR2 
GO  TO  5 

3  XXX  s  XR3 
GO  TO  5 

4  RDELN  »  (XR4  -  RFVl)/9.a45 
GO  TO  6 

5  RDELN  «  (XXX  -  RFSl)X9«a45 

6  RDNM  «  RDELN  +  ALPHA*(RKP-RKP1 ) 

RNM  ■  RNMl  ^  RDNM 

RNDM  »  (FNDF*C0N1 )/C0N2 

RNWM  s  RNM  -  RNDM 

RNWF  «  RNWM  *  ( C0N2*i^2/CeNl  ) 

REF  »  (RNWF*FKF*FKF)/373000. 

RRF  =  (REF  *  .62197)/{PRES  -  REF) 

RNF  s  RNWF  +  FNDF 

RETURN 

END 
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RAWC0N--WET^  INDIRECT  REFRACTIVITY  CALCULAT I 0NPAGE  I 

$IBFTC  XWET  DECK 
subroutine  WET 
CeNMON  /ADATA/  EH20(1000) 

COMMON  /2PARAM/  ZS/RFSl/RFVl/RNMl^ 
RKP1^ANDF1,aNWF1,ACMRVP/ 

1CQRMR/C0RVP,C0RIN/ ITPROBy IHUM/ 

IRSCT/PUNCH/KPARiBETAliBETA2iBETA3i 
2BETA4/BETA5/ AUPHAi RADIUS/ R^ A 
common  /PAT0UT/  PRES/SPEED/S/TKSA/ 

TEK/TVTX/FKF/TF/PTEMP/FNDF 
C8MM0N  /WET0UT/  ARF/ AEF/ ANWF/ ANF 
FQO  =  1.4/*4 
UM  5  1. 

lEW  .  TKS4*10»  +  501.5 

IF  (iew,le.o)  go  to  2 

EW  s  EH20(IEW) 

GO  TO  3 

2  EW  =  0. 

3  CON  «  1.  +  BETA1*S»F00 

ARF  s  (UM*0»62197*EW)/(PRES*CQN  -EW) 

AEF  =  PRES*ARF/( .62197+ARF) 

ANWF  =  373000. »AEF/(FKF*»2) 

ANF  s  FNDF  +  ANWF 
IF  (ANWFI)  6/6/4 

6  ANWFI  s  ANWF 
ANDFI  »  FNDF 

4  IF  (RNMl)  7/7/5 

7  CON  s  1.  +  BETA5*S»F80 
C0N2  s  1.  +  BETA5*S 

RNWMl  »  ANWFl*C0N/(CeN2**2) 

RNDMl  •  (ANDFl*CeN)/C0N2 
RNMl  «  RNWMl  RNDMl 

5  RETURN 
END 
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$ibftc  xsfdat  deck 

SUBReUTINE  SFDATP 
C  SKIP  TO  AN  END  OF  FILEt 

common  /ZTAB/  P^N/TAB{400) 
100  CALL  RDATP 

IF(N  ‘NE.  0)  GO  TO  100 
RETURN 

end 
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$ibftc  blkpar  deck 

BLOCK  data 

integer  PARAN 

COMMON  /ZPARAN/NPAR/PARAN{2,60) 

COMMON  /ZPARAM/  ZS/RFS1,RFV1,RNM1, 
RKPUAnDF1/ANWF1,ACMRVP, 

1  CORMRyCORVP/CORINWTPROB,  IHUM^ 

IRSCT,PUNCH/KPAR/BETA1/BETA2/ 

2  BETA3/BETA/+/BETA5>  ALPHA/RADIUS^R^A^PROCS/DUMP/ 

3  PVMIN/PVMAX/PMINiPMAX/SVMIN^SVMAX/ 


SMIN^SMAX,T4VMIN^T4VMAX/ 

4T4MIN/T4MAX/ 

5  EKVMIN#EKVMAX/EKMINiEKMAX/VXVMIN^VXVMAX,VXMlN^VXMAX, 
6MISSID/TSTART,TST0P/CPRES,CSPEED/ 

CKS4T/CEKT/CVXT>Z0FSl/CHKFC 
DATA  NPAR/  57/ 

DATAC  (PARANd/ J)i  I«1/2),  J=1,27)/ 

16HZS 


/ 1 / 6HANDF 1  j I / 


/1/6HRFS1  n^SHRFVl 
d#6HRNMl  >d6HRKPl 
26HANWF1  ^  l/6HACMRVPd/6HCeRMR 

/d6HC0RVP  /d6HC0RlN  d#6HITPR0B^2i 
36HIHUM  >2i6HIRGCT  /2#6HPUNCH 

/3#6HKPAR  ^2/6HBETAl  /1/6HBETA2  /d 
46HBETA3  /1/6HBETA4  M/6HBETA5 

/d6HALPHA  /l/6HRADIUS/d6HR  d/ 
56HA  /1/6HPROCS  /3i6HDUMP  ,3/ 

DATA(  (PARAN(  d  J)dd/2)#sJsa8/47)/ 

16HPVMIN  /1/6HPVMAX  /1/6HPMIN 

d^6HPMAX  d>6HSVMIN  /1/6HSVMAX  ,1, 
/I16HSMAX  ,  d6HT4VMIN/l/6HT4VMAX/d 
/1/6HT4MAX  ^dSHEKVMjN/ 

},i6HEKVMAX/ d6HEKMlN  d/6HEKMAX 
46HVXVMIN/ l>6HVXVMAXd/6HVXMIN  /l/6HVXriAX  /!/ 
DATA(  (PARAN(  Ii  J),  m/2)/ Js48/56)/ 

16HMISID  /4^6HTSTART/546HTST0P 

i5/6HCPRES  /  1  >  6HCSPEEDif  1  /  6HCKS4  T  /!/ 
26HCEKT  id6HCVXT  /d6HZ0FSl  ,1/ 

DATA  PARAN{li57)/PARAN(2/57)  /6HCHKFC  ,3/ 
logical  PUNCH, PR0CS,DUMP/CHKFC 


26HSMIN 

36HT4MJN 


DATA 

data 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 


RFSl 
RFVl 
RNMl 
RKPl 
ANDFl 
ANWFl 
ACMRVP/0 
CORMR  /O 
CORVP 
CORIN 


/1871./ 

/O./ 

/3 1 6 
/285 


/ 

94/ 


/O' 

/O' 


/ 
/ 
/ 
/ 

/o./ 

/o./ 
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data 

ITPR9D/1/ 

DATA 

I  HUM 

/O/ 

data 

IRSCT 

/!/ 

data 

PUNCH 

/.FALSE*/ 

data 

KPAR 

/!/ 

DATA 

BETA! 

/. 0002632/ 

DATA 

BETA2 

/-. 0002106/ 

DATA 

BETAS 

/-. 0000648/ 

DATA 

BETA4 

/  .0001316/ 

DATA 

BETAS 

/  .0000658/ 

DATA 

ALPHA 

/-.75/ 

DATA 

RADIUS/6357000./ 

data 

R 

/6354120./ 

DATA 

A 

/6356363./ 

DATA 

PR0CS 

/.TRUE./ 

DATA 

DUMP 

/.FALSE*  / 

data 

ZS 

/535.4117/ 

DATA 

PVMIN 

/18./ 

DATA 

PVMAX 

/1017./ 

DATA 

PMIN 

/600./ 

DATA 

PMAX 

/1060./ 

DATA 

SVMIN 

/691./ 

DATA 

SVMAX 

/1060./ 

data 

SMIN 

/135./ 

DATA 

SMAX 

/I95f/ 

Data 

T4VMIN/190./ 

data 

T4VMAX/891./ 

data 

T4MIN 

/’'40 1  / 

DATA 

T4MAX 

/35.9/ 

data 

EKVMIN/278./ 

data 

EKVMAX/769./ 

data 

ekmin 

/-40./ 

DATA 

EKMAX 

/35.9/ 

DATA 

VXVMIN/241./ 

DATA 

VXVMAX/1050./ 

DATA 

VXMIN 

/-40./ 

DATA 

VXMAX 

/32./ 

DATA 

MISSlD/1/ 

DATA 

TSTART/0./ 

DATA 

TSTBP 

/86399./ 

DATA 

CPRES 

/O./ 

DATA 

CSPEED/0./ 

DATA 

CKS4T 

/O./ 

DATA 

CEKT 

/o./ 

DATA 

CVXT 

/O./ 

DATA 

ZSFSl 

/914./ 

DATA 

CHKFC 

/.TRUE./ 

END 
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$IBMAP 

xkhaR 

DECK 

KHAR 

SAVE 

l/2/3#4/5 

ZET 

NWMIS 

TRa 

STRTMS 

KBEG 

CtA*^ 

3^4 

SUB 

KEAST 

TMI 

err 

PAX 

f  1 

CEA* 

3/4 

STO 

KEAST 

TSX 

NXTCHR, 5 

TlX 

>^-1/  1/  1 

PAC 

f  1 

TXE 

CKE0E/1/-33 

CEA 

TABEE/ 1 

return 

KHAR 

CKE0E 

EDq 

»11 

CAS 

soaoo 

TRA 

»  +  B 

EDQ 

-10 

XCA 

RETURN 

KHAR 

ir 

nxtchr 

EOU 

* 

EAC 

CURB  IT/ 2 

TXL 

NXTWRD/2/0 

TXH 

NXTWRD/ 2/ -8 

EDO 

CURWRD 

ege 

8 

ANA 

50377 

stg 

CURWRD 

TXI 

*+1/2/8 

sca 

CURDIT/2 

TRA 

1/5 

NXTWRD 

EXA 

WRDCNT/3 

TNX 

RDREC/3/ 1 

SXA 

WRDCNT/3 

SHIFTN 

EDq 

CURWRD 

EGE 

/2 

EAC 

CURPOS/ 3 

EDQ 

/  3 

TXI 

*  +  l/  3/  '-l 

SCA 

CURPOS/ 3 

TXI 

*  + 1  /  2  /  8 

SXA 

TEMP/2 

STARTING  A  NEW  MISSION 
YES. 

GET  CHARACTER  C0UNT 
Haw  MANY  PAST  EAST 
BACKWORDS  IS  A  N  ERRBR 

THIS  CHAR  WIUL 
BE  LAST  8N  NEXT  ENTRY 

GET  NEXT  character 
KEEP  going  untie 

have  proper  one. 
convert  character 
if  it  i  more 

than  33  CHECK  IF  IT  IS  EOE* 


11  IS  A  BAD  CHAR 

BUT  CHECK  IF  IT  IS  EOE  . 

N0. 

YES.  EOE  IS  1/ 

PUT  IT  IN  AC. 


GET  NEXT  character 
BITS  EEFT 

TRA  IF  EESS  than  8  bits  EEFT 
get  word 

GET  CHARACTER 


BUMB  BIT  COUNT. 

» 

RETURN 

need  another  word 
bump  counnt^ 

AND  TRA  if  no  more. 

GET  CURRENT  WORD 

USE  whatever  BIS  IT  HAS 
CURRENT  POSITION  IN  BUFFER, 
GET  WORD. 

BUMP. 

AND  STORE. 

HOW  MANY  BITS  OF  NEW  WORD. 


96 


RAV^C0N--KHAR^  input  a  character 


PASE  ?. 


LAC 

TEMP, 2 

lgl 

,2 

SHIFT  IN 

STG 

CURWRD 

ANA 

S0377 

txi 

*+1/2,36 

REMAINING  IN  NEW  W0RD 

sxa 

CURBIT,2 

TRA 

1,5 

RDREC 

call 

rdatp 

GET  NEXT  RECORD 

NZT 

N 

IS  IT  EOF. 

TRA 

EOF 

YES* 

RDRECl 

AXT 

TAB, 4 

N0.  RESET  POINTERS. 

SXA 

CURP6S,4 

CLA 

N 

GT0 

wrocnt 

TRA 

SHIFTN 

G0  SHIFT  IT  IN. 

STRTMS 

STZ 

CURBIT 

START  0F  MISSION 

NO  BITS  IN  CURWORD. 

STZ 

wrdcnt 

NO  WORDS  SIN  BUFFER* 

STZ 

KLAST 

AND  THERE  WAS  NO  LAST  CHAR 

STZ 

NWMIS 

RESET  new  MISSION  INDICATOR 

TRA 

kbeg 

E0F 

call 

RDATP 

AXT 

0,2 

A  NEW  file  always 

STARTS  A  NEW  CHARACTER 

ZET 

N 

IS  IT  double  end  0F  FILE. 

TRA 

RDRECl 

NO.  IGNORE  THE  FIRST  EOF. 

STL 

E0M 

YES.  END  OF  MISSION. 

STL 

NWMIS 

CLA 

»10 

RETURN 

KHAR 

ERR 

call 

EXIT 

table 

EGU 

* 

■BITS  OFFSET  I 

DEC 

11 

DEC 

1 

00000001  1 

DEC 

2 

00000010  2 

DEC 

11 

3 

DEC 

4 

00000100  4 

DEC 

11 

5 

DEC 

11 

6 

DEC 

7 

00000111  7 

DEC 

8 

00001000  8 

DUP 

1,10 

DEC 

11 

DEC 

3 

00010011  19 

DEC 

11 

20 

DEC 

5 

00010101  21 

DEC 

6 

00010110  22 

DEC 

11 

23 
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DEC 

11 

84 

DEC 

9 

00011001 

25 

DUP 

1^6 

DEC 

11 

DEC 

0 

00100000 

32 

CUR81T 

PZE 

CURWRD 

PZE 

CURP0S 

PZE 

WRDCNT 

PZE 

KLAST 

PZE 

TEMP 

PZE 

UORG 

ZNWMIS 

CONTRL 

ZNKMIS 

USE 

ZNWMIS 

NWMIS 

ess 

1 

ZE8M 

cqntrl 

ZE0M 

USE 

ZESM 

E8M 

BSS 

1 

ZTAB 

C8NTRU 

ZTAB 

USE 

ZTAB 

P 

BSS 

1 

N 

BSS 

1 

TAB 

BSS 

400 

END 

PAGE  3 
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IBMAP  XL0GC0  DECK 

* 


* 

« 


entry 

L0GC0M 

L0GCeM 

NULL 

CLA* 

3/4 

SUB* 

4/  4 

TZE 

ZAC 

TRET 

TRa 

1/4 

TRET 

CLA 

TRA 

END 

1/4 

COMPARES  TW0 

arguments  and  returns 

L0QICAL  variable. 

true  if  they  are  equal 

FALSE  IF  THEY  ARE  N0T. 


FIRST  ARG. 


SET  T0  RETURN  FALSE. 
EQUAL*  RETURN  TRUE. 


CL  :z 


$IBMAP 

INPUT 

RDATP 


RET 

ZTAB 


TAB 

GENTRY 


RAWceN-- 

RDATP/  READS 

INPUT  TAPE 

PAGE 

xrdatp 

DECK 

EIUE 

/A{1)/0EFER/ 

INPUT/BLK=254 

/BIN 

save 

TSX 

.OPEN/ 4 

OPEN  THE  FILE  EVERYTJNE 

pze 

INPUT 

STZ 

N 

A  ZERO  IN  N 

means 

AN  EOF  WAS 

FOUND* 

TSX 

tREAD/4 

PZE 

INPUT 

PZE 

RET/ / *"2 

lORT 

T  AB/ / ** 

INPUT  INTO 

TaB  in  COMMON. 

LXO 

*-1/4 

PUT  COUNT 

SXa 

N/4 

IN  N. 

return 

RDATP 

CONTRL 

ZTAB 

USE 

ZTAB 

BSS 

1 

BSS 

1 

BSS 

400 

END 

AIDA 
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$IBFTC  TFILES 

BLOCK  data 

C0MM0N  /ZFILE  /  NFILES,FILEID(20) 

DATA  NFILESiFILEID/20/ 

X  6HFILE01/6HFILE02/6HFILE03/6HFJLE04/ 
6HFILE05#6HFILE06^6HFILE07/ 
X  6HFlLE08^6HFlLE09i6HFILE10/6HFILEU^ 
6HFILE12/6HFILE13/6HFILEU/ 
X  6hFILE15/6hFILE16/6hFILE17/6hFILE18/ 
6HFILE19#6HFILE20  / 

END 
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$IBFTC  XBLK 

BL0CK  DATA 


C 

C 

C 

C 


integer  fileid 

LOGICAL  PLTPT 

integer  XENPH/HTEMPH/HTLAB/HTCHR 
INTEGER  SUB 
LOGICAL  LGO/LNUMGO 
REAL  LFR0M,LT0/LBY 
REAL  LHTFR,LHTT0/LHTBY 


LOGICAL 

LOGICAL 

LOGICAL 


LFRGO 

LSGO,LSGRK 

ORD 


COMMON  /ZORD/  ORD 

common  /ZPLOTS/NFRAME^NPLOTSI 10) 

COMMON  /ZGRIDX/  MTL ( 10 ) / MTR ( 10 ) , 

XL ( 10 ) / XR ( 1 0 ) / DX (1 0 ) / XEMPH ( 10 ) / 

X  NXLAB(10)^NXCHR(10) 

COMMON  /ZGRJDH/  HTLOW ( 10 ) / HTMAX (10 ) / 

DHT ( 1 0 ) ^  HTEMPH ( 10 ) / HTLAB ( 1 0 ) ^ 

X  HTCHR(10)^MTB(10)/MTT(10) 

COMMON  /ZSUB/  SgB(lO) 

COMMON  /ZPLTPT/  PLTPT(a5) 

COMMON  /ZVRTTL/  LVRSZ(a)/LVRX^LVRY/LVRDUM(6)i VARTTL(5) 

COMMON  /ZFMT/  FMTdO) 

common  /ZNVAR/NVAR 

COMMON  /ZJOB/NJOBC^  JOBlDdO) 

COMMON  /ZLABEL/  LGO (10 ) AALPH ( 5/ 

10)/LSlZE(BdO)^LNYdO)/LNXdO) 

COMMON  /ZLNUM/  LNUMGO (10 ) / LNUMY (10 ) / 
LNUMSZ(adO)/LFR0M(lO)/ 

X  LTQdO)/LBY(10) 

COMMON  /ZLFR/  LHTFR/ LHTTO/ LHTBY/ 

LHTIX,LHTSIZ(2)/LFRGO(io)^ 

X  LFRS I Z ( 2  ) 

common  /ZLS/  LSG0dO)/LSSZ(2)/LSCHRdO)/LSQRKdO) 
common  /  zhtlbl/  LHTLX/LHTLY 


fmt  contains  the  format  for  reading  the  data. 

DATA  FMTd)/12H(  I6/7F7.1) 


/ 


PLTPT( I ) =.TRU»  MEANS  PLOT  THE  ITH 

variable  AS  DISCRETE  POINTS 
♦FaLS.  means  PLOT  IT  AS  A  CONTINUOUS  LINE. 

DATA  (PLTPT( I )/ 1=1/5)  /5*. FALSE*/ 

the  following  establishes  the  vertical  grid  (I.E.  GRID  FOR 
HRIZONTAL  LINES)  WHICH  REFERS  TO  HEIGHT* 

EACH  VARIABLE  COULD  HAVE  ITS  OWN  GRID  IF  DESIRED. 
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C  HTL0W  IS  THE  IGWEST  HEIDHT  18  BE  PL0TTEO 
C  HTMAX  IS  the  largest  HEIGHT  T0  BE  PL8TTED. 

C  DHT  IS  the  height  BETWEEN  GRID  LINES. 

C  HTeMPH  indicates  which  grid  lines  are  T0  Be  darkened. 

C  (HTEMPH*N  MEANS  DARKEN  EVERY  NTH  GRID  LINE) 

C  HTLAB,  and  HTCHR  CGNTRSL  THE  AUTOMATIC 

labelling  0F  GRIDIV. 

C  they  are  N0  L0NGER  USED. 

DATA  (HTLeWID/HTMAXd  ),DHT(I)/ 

HTEMPHI D/HTLABI I )/HTCHR( I ),I«l/5) 

X  /  0* ^ ^000 • / 500 * / 10/ 10/ 0/ 

X  0 • / 4000 • / 0 • / 0/ 0/ 0/ 

X  0» / 4000 • / 500* / 10/ 0/ 0/ 

X  0  •  /  4000  •  /  0  •  /  0/ 0/ 0/ 

X  0*/4000*i0»/0/0/0  / 

c 

C  NFRAME*NUMBER  8F  separate  FRAMES 

C  NPLOTSI I )*H0W  MAYNY  VARIABLES  T0  PLOT  8N  EACH  FRAME. 

DATA  NFRAME/ (NPLOTSd  )/ I«l/2)  /2/2/3/ 

DATA  NVAR  /5/ 

C 

c  mtl/MtR/Mtb/Mtt  control  the  margin 

SETTINGS  0F  LEFT  RIGHT  T0B  A 
C  MTLd  )/MTRd  )/MTBd  )/MTTd  )  CONTROL 

THE  placement  OF  THE  GRID  FOR 
C  THE  ITH  VARIABLE. 

C  they  are  the  margins  dN  raster  UNITS) 

TO  Be  left  on  the  LEFT/RIGHT/ 
c  BOTTOM/  AND  TOP  OF  THE  GRID  RESPECITIVElY* 

DATA  (MTLd  )/MTRd  )/MTBd  )/MTTd  )/ Isl/5)  / 

1  80/5/75/260/ 

1  80/5/75/260/ 

1  80/5/75/260/ 

1  80/5/75/260/ 

1  80/5/75/260/ 

C 

C  XL/XR/DX/XEMPH/NXLAB/NXCHR  ESTABLEISH 

THE  SCALLING  FOR  THE  VARIABLES 
C  WHICH  ARE  PLOTTED  IN  .THE  X  DIRECTION/ 

d.E.  VERITICAL  GRID-  LINES) 
c  tHeiR  Meaning  corrsponds  to  be  meaning 

FOR  THE  VERTICAL  SCALING. 

DATA  (  XLd)/XRd)/DXd  )/XEMPHd  )/ 

NXUABd  )/NXCHRd  )/I»»l/5)  / 

1  150./400./50./10/0/0/ 

A  300 . / 800* / 0 * / 0/ 0/ 0/ 

3  "5 . / 45 1 / 5  * / 2/ 0/ 0/ 

4  -5 • / 45. / 0 » / 0/ 0/ 0/ 

5  0./25./0./0/0/0  / 
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SUB  C8NTR8LS  THE  0RDeR  JN  WHICH  THE 

VARIABLES  ARE  PL0TTED/  S 
C  the  ITH  variable  was  the  SUB(I)TH 

number  Read  frbm  the  input  recsrd. 
data  (SUB( I )/ I»1/5) 

c 

C  LVRSZ  »  SIZE  F8R  LABEL  CHARACTERS 

(I.E.  variable  alpha  CHARS) 

C  LVRXAVRY  =  X  and  Y  C08RD  8F  START  8F  VARIABLE  TITLE 
C 

DATA  LVRSZ(1)^LVRSZ{2)>LVRX/LVRY  /3#3m00^12/ 

C 

C  NJ8BID  IS  PRINTED  IN  THE  FIRST  FRAME 

8F  A  R8LL  TO  DITIFY  THE  U8B. 

C  NJ0BC-NUMPBER  0F  CHARACTERS  IN  J8BID. 

DATA  NU8BC/ J0BID(1)  /7/7H  WjLSeN  / 

C 

C  LG8( I )a.TRUE.  MEANS  THAT  THERE  IS 

AN  ALPHABETIC  LABEL  ASSOCIATED 
C  with  the  ITH  VARlABLEf  THE  LABEL  IS  CONTAINED  IN 
C  LALPHd^I)  ...  LALPH(5/I) 

DATA  (LG8( I )/ Ul^5)  /3* . TRUE FALSE ./. TRUE .  / 

DATA  (LALPHdi  I)/ I«i>5)  / 

1  30HREFRACTIVITY  (N  UNITS)  > 

2  30HReFRaCtIVItY  (M  UNljS)  / 

3  30HTEMPERATURE  (DEGREES  C)  / 

4  0/30HVAP8R  PRESSURE  (MB.)  / 

C 

C  LSIZE( 1/ I )^LSIZE(2d )  ARE  THE 
C  LSiZEdi  I  )/LSIZE(a^  I )  INDICATE  THE 

SIZE  0F  THE  LABELING  F0R  THE 

C  ITH  variable.  L 

data  (  (LSIZE(  d  J)d*d2)>  J«1/5)  /10*2/ 

c 

C  LNX( I )/LNY( I )  ARE  THE  X  AND  Y  RASTER 

C8RDINATES  AT  WHICH  TO  BEGIN 
C  printing  THE  LABEL  FOR  THE  ITH  VARIABLE. 

DATA  (LNX(  I  )/LNY(  I  )d»d5)  /kQQ, 

36/400/  812/400/36/2»0/400/  812  / 

C 

C  LNUMGO( I )«.TRUE.  IDICATES  THAT  THE 

GRID  FOR  the  ITH  VARIABLE  SHOULD 
C  HAVE  numeric  LABELS  ATTACED. 

DATA(LNUMG0( I )/ 1*1/5)  /3». TRUE./ .FALSE./ .TRUE./ 

C 

C  LNUMSZd/ I  )/LNUMSZ(2/ I  >  INDICATE  THE 

SIZE  OF  THENUMERIC  LABELS. 
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DATA  { (LNUNSZI I/J)/ 1-1^2)# J«li5)  /10*Z/ 

C 

C  LNUMY(I)  IS  THE  Y  RASTER  COORDINATE 

FOR  THE  NUMERICA  LABELS  A  OF  THE 
C  ITH  variable,  the  X  COORDINATE  IS 

DETERMINED  BY  THE  VALUSE  TO  BE  PRINT 
DATA  (LNUMY( I)/ 1*1/5)  /  53/793^53/0/792  / 

C 

C  LFReM(I)^LT0(I)/LBY(I)  INDICATE  THE 

NUMBERS  TO  BE  USED  AS  NUMERIC 
C  labels.  LABELS  ARE  PLACED  UNDER  THE 

GRID  AT  POSITIONS  CORRESPONDING 
C  TO  numbers  between  LFROMd)/  AND  LT0(I)/ 

separated  BY  LBY(I) 

DATA  (LFROM(I)/LT0(I)/LBY(I>/I-1/5)  /150./ 400./50./ 

X  300 . ^ 800 . / 100 . /  0./40./10./  3*0*/  0*/25*/5*  / 

C 

C  LHTFR/LHTTO^LHTBY  are  similar  to  LFROM/ 

LTO/LBY  except  they  are  used 
C  in  LABELING  THE  HEIGHT  COORDINATE. 

DATA  LHTFR/LHTTO/LHTBY  /O./ 4000./500.  / 

C 

C  LHTIXAHTSIZ  correspon  to  LNUMY  and 

LNUMSZ  FOR  the  HEIGHT  CORRD. 

DATA  LHTIX/LHTSIZ(1)/LHTSIZ(2)  /  30/3/2/ 

C 

C  LFRG0( I )«LABEL  A  FRAME  WITH  THE  HEIGHT 

COORDINATES  AND  VARIABLE 
C  DESCRIPTION  FREAD  AS  INPUT. 

DATA  (LFRGOi I )/ I-1/5)  /.TRUE*/ 

.false*/ ‘TRUE*/ 3*. false*/ 

C 

C  ORD-.TRUE.  MEANS  PLOT  THE  POINTS  IN  ORDER  BY  HEIGHT. 

C  ORD«. false,  means  PLOT  THE'  POINTS 

IN  THE  ORDER  THE  ARE  READ  IN. 

C  THIS  only  effects  VARIABLES  FOR  WHICH  PLTPF* .FALSE. 

DATA  ORD/.TRUE./ 

C 

C  LSGO  controls  THE  LABELING  OF  LINES  FOR  EACH  VAR 
C  LSGOI I)-.TRUE.  MEANS  LABEL-  THE  LINE 

WITH  the  character  LSCHR(I). 

C  THE  CHARACTER  IS  PLACED  JUST  ABOVE 

the  HEIGHEST  point  WHICH  WAS  PLOTTE 
DATA  (LSG0( I)/ 1*1/5)  /5*.TRUE./ 

DATA  (LSCHRI I )/ 1-1/5)  /6HOOOOON/ 

6H00000M/ 6H00000T/ 7/ 6H00000E/ 

Lssz  controls  the  size  of  the  characters 

USED  TO  LABEL  LINES. 
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DATA  LSSZ(1>/LSSZ(2)  /3/3/ 
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LSGRK  INDICATES  WHETER  THE  CHARACTER 

USED  T9  label  THE  VARIABLES  IS 
T0  BE  ROMAN  OR  GREEK.  LSGRK{ I ) c .TRUE. 

Means  the  character  F0R  the 

ITH  variable  IS  GREEK,  .FALSE.  MEANS  R8MAN. 

DATA  (LSGRK( I ), I»l,5)  /3*. FALSE./ .TRUE., .FALSE.  / 

LHTLX/LHTLY  »  X,Y  START  C6dRD  6F  TITLE  WHE  SAYS  'HEIGHT* 

DATA  LHTLX/LHTLY  /10,300  / 

END 
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$ibftc  $mlblk 

BLOCK  DATA 

C  0NLY  SETS  VARIABLES  WHICH  ARE  DIFFERENT 

FR0M  VALUSE  REQUIRED  F0R 

C  LARGE  PL0TS 

C  PUTS  BOTH  PLOTS  ON  ONE  FRAME  IN  REDUCED  SIZE 

C  SETS  UP  COMMONS  TO  PLOT  A  REDUCED  SIZE 
INTEGER  XEMPH/HTEMPH/HTLAB/HTCHR 
real  LHTFR/LHTTO/LHTBY 
COMMON  /ZLNUM/  LNUMG0 (10 ) / LNUMY ( lo ) / 
LNUMSZlB/lOI/LFROMdO)^ 

X  LTOdOiLBYdO) 

COMMON  /ZVRTTL/  LvRSZ(a)/LvRX/LVRY/LVRDUM(6)/VARTTL(5) 
common  /ZLABEL/  LGOdO) AALPH(5^ 

lO)iLSlZE(2dO)/LNYdO)^LNXdO) 

common  /  zhtlbl/  lHTLX/LHTLY 

COMMON  /ZQRIDX/  MTU dO ) / MTR (JO ) / 

XLdO)/XRdO)/DXdO)/XEMPHdO)/ 

X  NXLABdO)/NXCHRdO) 
common  /ZGRIDH/  HTL0WdO)/HTMAXdO)/ 

DHTdO)/HTEMPHdO)#HTLABdO>i 
X  HTCHRdO)^MTBdO)/MTTdO) 
common  /ZLFR/  LHTFR/LHTTOAHTBY/ 

LHTlX/LHTSIZ(2)/LFRGedO)/ 

X  LFRS I Z ( 2 ) 

COMMON  /ZLS/  LSG0dO)/USSZ(2)^LSCHRdO)/LSGRKdo) 
common  /ZPLOTS/NFRAME^NPLOTSdO) 

DATA  (HTL0W( I )/HTMAX( I ),DHT( I )/ 

HTEMPH(  D/HTLABd  )/HTCHR(  I)/I.l/5) 

X  /  0./4000»d000./ 10/0/0/ 

X  0 * /  4000 •  /  0 ♦  / 0/ 0/ 0/ 

X  0*/4000»/ 1000#/10/0/0/ 

'  X  0 • / 4000  * / 0 ♦ / 0/ 0/ 0/ 

X  0»/4000./0./0/0/0  / 

DATA  (MTL(I)/MTR(I)/MTB(I)/MTT(I)/I*l/5)  / 

1  80/500/75/660/ 

1  80/500/75/660/ 

1  575/0/75/660/ 

1  575/0/75/660/ 

1  575/0/75/660  / 

data  LHTBY  /lOOOt/ 

DATA  LNUMY  753/ 392/ 53/ 0/ 392/ 5*0/ 

DATA  (LNX( I )/LNY( I )  /I*l/5)  /150/ 

36/150/412/670/36/2*0/670/412  / 
data  LHTLX/LHTLY  /  10/150/ 

DATA  LSSZ  /2/2/ 

DATA  NFRAME  /!/ 

DATA  NPLOTSd)  /5/ 

DATA  LVRSZ/LVRX/LVRY  /  3/3/300/12  / 


107 


PL0T--BL0CK  DATA  F0R  SMALL,  PLOTS  PAGE  2 

END 
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$ibftc  xPieT 

C8MMBN  /ZVAR/  VAR(2000/5) 

CQMMBN  /ZHT/  NPTS/ HT ( 3000 ) 

CBMMBN  /ZPUeTS/NFRAME^NPLOTSdO) 

CeMMeN  /ZGRIDH/  HTLbW ( 10 ) # HTMAX( 10 ) / 

OHT(10)/HTEHPH(10)/HTLAB(10)/ 

X  HTCHR(10)/MTB(10)/NTT(10) 

CBMNBN  /ZGRIDX/  MTL(10)/MTR(10), 

XL ( 10  )  ^  XR ( 10 ) / ox ( 10 ) / XEMPH ( 10  >  ^ 

X  NXLAB(10)/NXCHR(10) 

C8MM8N  /ZPLTPT/  PLTPTiaS) 

C8MM0N  /ZSUB/  SUB{10) 

C8MMBN  /ZJBB/NJBBC^ JBBID(IO) 

INTEGER  SUB 
UBGICAL  PLTPT 

INTEGER  HTEMPH#HTLA8/HTCHR/ XEMPH 

EXTERNAL  TABLlV 

WRlTE(6/902) 

CALL  CHSIZV{15/9> 
call  RITSTV(150/150/TABL1V) 

CALL  RITE2V(50/500/1000  ^90/ I/NJBBC/-!, jBBID/NERR  ) 
CALL  PRINTV(-7/7HSCHWARZ/50/50> 

100  continue 

CALL  INPUT 
CALL  ORDER 
NVAR.O 

DO  300  NFR«1/NFRAME 
CALL  FRAMEV(2) 

Na«NPL6TS(NFR) 

00  300  I«1^N3 

NVARsNVAR^l 

NS»SUB{NVAR) 

C  NS«0  indicates  that  that  VARIABLE  IS  MISSING* 

IF(NS.EQ.O)  G0  T8  200 

CALL  SETMIV(MTL(NVAR),MTR(NVAR)/MTB(NVAR)/MTT(NVAR)  ) 
CALL  GRI01V(2,XL(NVAR)/XR(NVAR)/ 

HTU8W(NVAR)/HTMAX(NVAR)/ 

X  OX (NVAR),DHT(NVAR)/ XEMPH INVAR)/ 

HTEMPH(NVAR)/NXLAB(NVAR)/ 

X  HTLAB(NVAR)/NXCHR(NVAR>/HTCHR(NVAR)  ) 

CALL  TITLE(NVAR) 

IF(,NeT.PLTPT(NFR> )  GB  T8150 
CALL  APLBTV(-NPTS/VAR(1/NS)/HT/1/1/1/42/NERR) 
IF{NERR.GT.0)  WRITE(6/900)  nerr 
GS  T8  200 
150  NERRpO 

08  160  J*1/NPTS  I 

JL«U+1 

NXL*NXV(VAR( J/NS)  ) 
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NYL.nYV(HT( J) ) 

IF(NXL.NE»0  *AND.  NYLtNE*0)  08  TO  165 
160  NERR-NERR+1 
165  D0  180  J*Jt,/NPTS 
NXN«NXV( VAR( J/N$) ) 

NYN  sNYVtHK  J)  ) 

1F(NXN  .EQ«0  »0Rt  NYN.EQ.Q)  GQ  TO  170 
CALL  LINEV{NXL/NYL-»NXN/NYN) 

NXL»NXN 
NYLsNYN 
G8  10  180 
170  NERR«NeRR+1 
180  CeNTINUE 

IF(NERR*NE*0)  WRITE(6/900)  NERR 
200  CeNjINUE 
300  continue 
00  TO  100 

900  FORMAT!  IIH  THERE  WERE^15/12H  BAD  POINTS.) 

901  F0RMAT(1H1/9X^6HHEIGHT/(10X,6F10.2) ) 

902  F0RMAT(iHl) 

END 
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$ibftc  xinput 

subroutine  input 

C0NM0N  /ZHT/  NPTS/HT(aOOO) 

CBMMON  /ZVAR/  VAR(a000/5) 

COMMON  /ZVRTTL/  XVTTL ( 5 ) / YVTTL ( 5 ) / VARTTL ( 5 ) 

COMMON  /ZNVaR/NVaR 
COMMON  /ZFMT/FMTdO) 

COMMON  /ZFILE/  NF IUES/ F ILE I D ( 20 > 

INTEGER  FILEID/FIuE/FIL 
INTEGER  CURFIU 
INTEGER  XVTTLiYVTTL 
LOGICAL  EOF 
DATA  MAXPT$/2000/ 

DATA  NST0P/6H*ST0P*  / 

DATA  CURFIL/1/ 

INPUT  SUBROUTINE 

READ  IN  REQUESTS.  AND  APPROPRIATE  DaTAS. 

100  NPTS  *  0 

READ  (5/ 900)  MISSR/KLOW/KH^CONTEX,  VARTTL 
IF(  MISSR  •EO*  NSTOP)  STOP 
DO  110  FIL-1/NFILES 
FILE  «■  FJL 

110  IF(FILEID(FIL).EQ. MISSR)  GO  TO  120 
WRITE{6/901)  MISSR 
C  THE  requested  MISSION  IS  NOT  ON  THE  TAPE. 

GO  TO  100 

120  IF(CURFIL  .EQ»  FILE)  GO  TO  150 
IFICURFIL  .LT.  FILE)  GO  TO  l30 
C  THIS  FILE  IS  BEFORE  CURRENT  FILE 
WRlTE(6/902)  MISSR 
GO  TO  100 

130  NSKIP  •  FILE-CURFIL 

c  SKIP  files  to  proper  one 

DO  140  N»l/NSKIP 
140  CALL  SKPFIL 

curfil-file 

150  continue 

200  READd/FMT)  KOUNT#  HT  (  NPtS+1  )  /  ( VAR  I  NPTS+d  I )  d  *  1/ NVAR ) 
IF(E0F(1) )  GO  TO  290 
IFIkOUNT  .LT.  KLOW)  qO  TO  200 
IF(K0UNT  .GT.  KHI)  go  to  300 
NPTS  «  NPTS^l 

IFINPTS  .GE.  MAXPTS)  go  to  300 
IFIKOUNT  .EQ.  KHI)  GO  TO  300 
GO  TO  200 

290  CURFIU»CURFIL*1 

300  WRlTE(6/903)  VARTTL^ MISSR^KLOW^KHI/NPTS 
IF(NPTS  .EQ.  0)  GO  TO  100 
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RETURN 

900  F0RMAT(A6/2X/2I5/A1/5A6) 

901  FORMAT (20H0THERE  IS  NO  MISSION 

A6/17H  REQUEST  IGNORED.  ) 

902  F0RMAT(20H0REQUEST  FOR  MISSION 

A6#17H  IS  OUT  OF  ORDER./ 

X  17H  REQUEST  IGNORED.  ) 

903  FORMAT! IIHOGRAPHS  FORi IXi 5A6/ 3X^ 

7HMISSI0N/A6/5H  FR0M/I5/3H  TO/ 
X  15/lH./ I6/13H  DATA  POINTS.  ) 

904  F0RMAT(A1/1OI5) 

905  FORMAT!  25H  TOO  MANY  EXCLUSION  CARDS) 

END 
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$ibftc  xinrad 

C  INPUT  R8UTINE  F0R  THE  RADIOSONDE  DATA 

(WHICH  HAS  already  BEEN 
C  processed  onto  a  TAPE) 

C 

subroutine  INPUT 

INTEGER  VARTTLiFIXTTL 

dimension  KDAY(50)'‘<STAT(50)/FIXTTL(5) 

LOGICAL  FIRST 
LOGICAL  EOF 

COMMON  /ZHT/  NPTS/ HT ( 3000 ) 

COMMON  /ZVAR/  VAR(2000/5) 
common  /ZVRTTL/  XXV( 10),VARTTL(5) 

COMMON  /ZSUB/  NSUB(IO) 
dimension  ISUB(IO) 

DATA  ISUB/5/4/l#3/2/5#0/ 

LQQICAL  ALLSTA/ALLDAY 

DATA  FIxTTLd)  /30HSTAT#  DAY^  HR 

/ 

DATA  FIRST/. TRUE./ 

C  ONLY  DO  INITIALIZATION  ONCE 
IF( .NOT. FIRST)  GO  TO  100 
DO  10  1^1/5 
10  NSUB( I )*ISUB( I ) 

READ(5i900)  NSJAT/  ( KSJAT (I ) / I » 1/ NStAT ) 
read (5/ 900)  NDAY/ (KdAY( I )/ I»liNDAY) 

WRITE (6/ 901 )  NSTATi  (KSTAT(  I  )i  Ul^NSTAT) 
WRITE(6,902)  NDAY/  ( KDAY ( I ) d p 1 / NDAY ) 
ALLSTA-NSTAT.LE.O 
ALLDAY  *  NDAY.LE.O 

100  first»*false. 
c  read  header  record 

READd)  MSTAT^NX/NX^NX/MHRiMDAY/MMO/  IbOT/ITOP 
IF(EOFd))  STOP 

READd)  ( (VAR(  dJ)^U-l>4)  d  *1/500) 

READd)  SKIP 
IF(ALLSTA)  go  to  140 
DO  130  I-l/NSTAT 

130  IF(KSTAT{I).EQ.MSTAT)  go  to  140 
GB  TO  100 

140  IF(ALLDAY)  G8  to  160 
DO  150  Isl/NDAY 

150  IF(KDAY(I)  .EQ.  MOAY)  GO  TO  160 
GO  TO  100 
160  CONTINUE 

DO  180  1*1/5 
180  VARTTUd  )*FlXTTUd  ) 

VARTTL(3)  *  MSTAT 
VARTTL(4) »MDAY 
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VARTTL(5)  »  MHR 
WRITE(6#903)  VARTTL 

C  THE  DATA  MUST  BE  MADE  INTO  WHAT  WE  WANT  TO  PLOT. 
NPTS«ITOP"IBOT+l 
DO  200  NpI/NPTS 
NN^n+IBOT-I 
C  VAR(3)  IS  HT 

HT(N)*VAR(NN/3) 

c  vAR(i)  IS  temperature 

VAR(N/1)  =  VAR{NN/1) 

c  var(2)  IS  Dew  point/  change  it.td  vapor  pressure 
C  the  formula  used  is  An  empirical  relation 

determined  by  JOHN  skillman 

VARIN/B)**  10***  (35. 058-3009 *5/(273* 2  +  VAR(NN/2)  ) 

X  -5.439*AL0G1O(273.2+VAR(NN^2) )  ) 

c  vaR(4)  is  m#  it  does  not  Have  to  be  changed* 

VAR(N/4)*VAR(NN/4) 

C  SETUP  VaR(5)  as  N. 

VAR(Ni5)  «VAR(NN/4)-VAR(NN/3)/6371*2E3  *1*E6 
C  VAR  3  IS  POTENTIAL  TEMPERATURE 

PRESsl013**EXP(-980*»HT(N)*100*/2*87E6/280* ) 
VAR(N/3)'(VAR(N/l)+273* )*( 1000./PRES)**.286-273*0 
200  continue 

RETURN 

900  FORMAT! 16# llA6/( 12A6) ) 

901  FORMATdHl#  I4#10H  ST  AT  I ONS  *  1 1 A6/ ( 15X/ 12A6  )  ) 

903  F0RMAT(I5#6H  DAYS.4X# U A6/ ( 15X# 12A6 ) ) 

903  F0RMAT(5X#5A6) 

END 
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$IBFTC  XORDER 

SUBReUTINE  order 

COMMON  /ZORD/  0RD 

COMMON  /ZHT/  NPTS/ HT ( EOOO ) 

COMMON  /2VAR/  VAR(a000/5) 
logical  ORD 

DATA  MAXVAR/5/ 

LOGICAL  UP/DOWN 
lF(iNeT.0RD)  RETURN 
UP  «  HT{NPT$)  .GT.  HT(1) 

C  SORT  WILL  be  ASCENDING  OR  DESCENDING 

DEPENDING  ON  OVERALL 

C  DIRECTION. 

DOWN  «  .NOT.  UP 
N  •  1 

100  IF  (N  .GE.  NPTS)  RETURN 

IF(UP»AND.HT(N) ♦GT.HT(N+1 )  )  GO  TO  150 
IF(  DOWN. AND. HT(N) .LT.HT(N+i )  )  G0  TO  i50 
N  »  N*1 
GO  TO  100 
150  continue 
X  »  HT(N) 

HTIN)*HT(N+1) 

HT(N+1)»X 

DO  200  I*1/MAXVAR 

X-VAR(  N#I) 

VAR(N/ I )«VAR(N+1/ I ) 

200  VAR{N+1/ I  )*X 
N«N»1 

IF(N.LE.  0)  N=1 
GO  TO  100 
END 
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$IBFTC  XTITLE 

SUBROUTINE  TITLE(NVAR) 
external  TABLIV 
external  TABL2V 
INTEGER  SUB 
INTEGER  XVTTL/YVTTL 
REAL  LHTFR/LHTT6iLHTBY 
LOGICAL  LFRGO 
logical  LGO/LNUNG0 
LOGICAL  LSGO/LSGRK 
REAL  LFROM/LTOiLBY 

common  /ZLS/  LSGO(lO)iLSSZ(2)/LSCHR(10),LSGRK(10) 
COMMON  /  ZHTLBL/  LHTLX/LHTLY 

COMMON  /ZVRTTL/  LVRSZ ( 2 ) / LVRX AVRY/ LVRDUM ( 6 ) , VARTTL ( 5 ) 
COMMON  /ZLABEl/  LGO ( 10 ) # LALPH ( 5# 

10)/LSIZE(2/10)>LNY(10)/LNX(10) 

COMMON  /ZLNUM/  LNUMGO (10 ) / LNUMY ( 10 ) / 
LNUMSZ(2/10)/LFReM(10)/ 

X  LT0(10)iLBY(l0> 

COMMON  /ZLFR/  LHTFR, LHTTO/ LHTBY/ 

LHTIX/LHTSIZ{2)/LFRQQ(10)/ 

X  LFRSIZ(2) 

common  /ZVaR/  VARI2000/5) 

COMMON  /ZHT/NPTS/HT(2000) 

COMMON  /ZSUB/  SUB (10) 

NUSEDsO 

IF( ,NOT.LFRGe(NVAR) )  GO  TO  150 
CALL  CHSIZV(LVRSZ(1)/LVRSZ(2) ) 

CALL  RITSTV(5*LVRSZ( 1 ),26/TABLiV) 

CALL  RITE2V(LVRX/LVRY/ 1023/90^ 1,30/"1/VARTTL/NUSED) 

Call  chsizv(lhtsiz(i )/Lhtsiz(2) ) 

CALL  R I TSTV ( LHTS I Z (1 ) *5+3/ 26/ TABLIV ) 

CALL  RITE2V(LHTLX/LHTLY/1023/ 180/ 

1/15/-1/15HHEIGHT  ( METERS )/ NUSED > 

AT»LHTFR 

125  CALL  BNBCDV(AT/BC0/NDS) 

CALL  RITE2V(LHTIX/NYV( AT)/ 1000/90/ 1/NDS/-1/ BCD/ NUSED) 
AT-sATtLHTBY 

IF(AT»LE.LHTT0)  GO  TO  125 
150  CONTINUE 

IF(.N0T.  LGO(NVAR))  go  TO  200 

CALL  CHSIZV(LSIZE(1/NVAR)/LSIZE(2/NVAR)  ) 

CALL  RITSTV(5*LSIZE( 1/NVAR)+3/26/TABLiV) 

Call  rite2V(Lnx(nvaR)/Lny(nvaR)/ 

1000/90/l/30/-l/LALpH(l/NVAR)/ 

X  NUSED) 

200  CONTINUE 

IF  ( ,N0T»LNUMGO(NVAR) )  GO  TO  300 

CALL  CHSIZV(LNUMSZ( 1/NVAR)/LNUMSZ(2/NVAR)  ) 
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CALL  RITSTV(5*LNUMSZ(1/NVAR)+3/26#TABL1V) 
AT  »  LFReM(NVAR) 

250  CALL  BNBCDV{AT/BCD/NSD) 

LEFT^NSD*  (5*UNUMSZ(1,NVAR)+3)  -3 
CALL  RnE2V(NXV(AT)-LEFT/LNUMY(NVAR), 
1023^90# 1/NSD^ -1/ BCD/ NUSED) 

AT  •  AT-fLBY(NVAR) 

IF(AT*LE*LT0{NVAR) )  00  T0  250 

300  continue 

IF( .N0T.LSG0(NVAR) )  GO  TO  350 
NS»SUB(NVAR) 

H*«0 

DO  310  I*l/NPTS 

IF(  HtGE.  HTII)  .0Rt  NYV(HT ( I ) ) .EQ.O 
.OR.  NXV(VAR( I/NS) )  .EQ.O) 

X  GO  TO  310 
H«HT(I) 

X»VAR(I/NS) 

310  continue 

CALL  CHSIZV(LSSZ(1)/LSSZ(2) ) 
lF(.NeT.LSGRK(NVAR)  )  CALL  VCHARVOO/ 

1/NXV(X)«5*LSSZ{ 1 )/NYV(H)+3/ 

X  LSCHR(NVAR)/TABL1V) 

IF(  LSGRK(NVAR))  call  VCHARVOO/ 

1/ NXV { X  > ’5*LSSZ ( I > i NYV { H ) +3/ 

X  LSCHR{NVAR)/TABL2V) 

350  continue 
RETURN 
END 

$ibftc  XSKP 

SUBROUTINE  SKPFIL 
LOGICAL  EOF 

10  READ(1/11)  I 

11  FORMATIAI) 

IFlEOFd))  RETURN 
GO  TO  10 
END 
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TRACE 

Main  routine  controls  flow  of  program. 

XGETCR 

Reads  control  cards  and  profiles.  Sets  up  COMMONS  for 
tracing.  Returns  when  a  *TRACE  card  is  encountered. 

XGETRA 

Sets  up  for  next  ray,  if  any. 

XBUMP 

Performs  iteration. 

XHTINT 

Function  which  returns  refractive  indexes.  Its  arguments  are 
height  and  range  and  it  normally  performs  some  interpolation. 
Also  puts  in  common  the  limits  of  linearity  for  the  interpola¬ 
tion  it  performed. 

XDFIND 

Utility  routine  to  locate  data  in  a  table. 

XATTEN 

Computes  attenuation  and  reflection  from  layer  or  surface. 

XPRINT 

Produces  all  printed  output. 

SFINISH 

Logical  function  which  decides  whether  or  not  to  continue 
tracing  current  ray. 

TRCBEK 

Block  data  containing  certain  defaults  and  sizes. 

XPLRAY 

Performs  manipulation  of  intermediate  plotting  tapes  at  end 
of  ray. 

XOUTAL 

Performs  plotting  of  all  rays  traced  since  it  was  last  called. 
This  is  the  only  routine  which  calls  the  assembly  language 
plotting  routines. 

XPLTPO 

Adds  current  position  to  intermediate  plotting  tape. 
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tlBvJQB  MAP 

$I8FTC  trace 

LOGICAL  sue 

DOUBLE  PRECISION  NHT/ NTHETA, NEL> NN, NRNG 
double  precision  CHT/CTHETA,CEL/CN/CRNG 
double  precision  NP8S(5)/CPeS(5) 

LOGICAL  HOLD 
common  /ZHOLO/HOLD 

common  /CURPOS/  CHT^CTHETA/CEL^CN,CRNG 
COMMON  /NXTP0S/  NHT^ NTHETA/ NEL/ NN, NRNG 
EQUIVALENCE  (CP0S(1)/CHT  ) / ( NP0S ( 1 ) ^ NHT  ) 

C  AUTHOR.  JERALD  SCHWARZ 
C  DATE  JUNE  1969- 
C 

c  COMMONS  and  variables 

C  /CURPOS/  COMMON  CONTAINING  THE  CURRENT 

POSITION  OF  the  ray 
C  CHT=  CURRENT  HEIGHT  (IN  METERS) 

C  CTHETA  =  CURRENT  THETA  (EARTH 

central  ANGLE  IN  RADIANS) 

CEL  «  CURRENT  ELEVATION  0  ANGLE  (IN  RADIANS) 

CN*  CURRENT  REFRACTIVE  INDEX 
CRNG=  CURRENT  RANGE  (ALONG  EARTH)  IN  METERS. 
/NXTP0S/  COMMON  CONTAINING  THE  NEXT  POSITION  OF  RAY 
I.E.  POSITION  BEING  CALCULATIOED. 

VARIABLES  ARE  SAME  AS  IN 

CURPOS  EXCEPT  NAMES  HAVE  N  AS  PREFIX 
/ZTRCP/  CONTAINS  TRACE  CONTROL  PARAMETERS 
STRTRG  c  START  RANGE  OF  NEXT  RAY 
STRTHT  =  START  HEIGHT  OF  NEXT  RAY  (IN  METERS) 
STRTEL  START  ELEVATION  OF  NEXT  RAY  (IN  RADIANS) 
STPRNG  p  range  at  WHICH  TO  STOP  TRACING 
BMPCT  »  NUMBER  OFRAYS  LEFT  TO 

TRACE  IN  THIS  SET  (A  SET  IS  DETER¬ 
MINED  BY  VBMP  AND  DEL) 

VBMP  CONTROLS  WHICH  START  PARAMETER 
SHOULD  BE  incremented 
=1  INCREMENT  START  RANGE. 

*2  INCREMENT  START  HIEGHT. 

*3  increment  START  ELEVATION. 

DEL  =  AMOUNT  TO  INCREMENT  PARAMETER 

EACH  TIME  PROGRAM  STARTS  A  NEW 

C  RAY. 

C  /ZRAD/  eRAO  =  EARTH»S  RADIUS  IN  METERS. 

•  C  /ZIXP/  IXPROF  @  THE  number  OF  THE  CURRENT  PROFILE. 

c  /zsnell  snellc  s  jhe  constant  of 

SNELLS  LAW  FOR  THUS  RAY. 

C  I.E.  N*( 1.+HEIGHT/RADIUS)*C0S(ELEVATI0N) 

C  /ZUP/  UP  S'  .TRUE.  WHEN  RAY  IS  PROCEEDING  UPWARD 
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•False  when  ray  in  going  oqwnward# 

IT  IS  SET  BY  GETRAY  AND  CHANGED  GY  BUMP. 

/ZPR0F/  CONTAINS  INF0RMATI0N  ABOUT  PROFILES 
NUMP*  NUMBER  OF  PROFILES  IN  CORE, 

PHT(I/U)  »  height  of  ITH  POINT  OF  UTH  PROFILE. 

PN(IiJ)  •  refractive  index  of  ITH  POINT  OF  UTH  PROFILE 

MaXPU)  p  number  of  POINTS  IN  JTH  PROFILE 

PRNG(J)  B  RANGE  AT  WHICH  JTH  PROFILE  IS  SITUATIED 
/ZOIM/ 

DiMPi  •  LIMIT  OF  NUMBER  OF  POINTS  IN  a  PROFILE 

DIMP2  »  LIMIT  ON  NUMBER  OF  PROFILE 

S  IN  CORE  (I,E.  ON  A  PATH) 

/ZTITLE/  TITLEpBCD  ARRAY  WITH  LABELING 
FOR  this  set  of  TRACES# 

/ZDELHT/  DELHT  ■  INCREMENT  IN  HEIGHT  BETWEEN  POINTS. 

IT  IS  USED  BY  BUMP  TO  GET  NhT. 

/ZESC/  ESCAPE  p  .TRUE.  INDICATES  THAT 

THE  RAY  IS  ABOVE  THE  PROFILE 

IN  CURRENT  USE.  THUS  IT  HAS 

ESCAPED  AND  TRACING  STOPS. 

/ZPRN/  PRINT  »  .TRUE.  INDICATE  THE  RAY  SHOULD  BE  PRINTED, 
/ZLEVEL/  controls  INTERPOLATION  IN  RAYNGe, 

NLEVi  number  of  LEVELS  (MUST  BE 

same  IN  EACH  PROFILE  OF  A  PATH) 

LHT(IiJ)  •  HEIGHT  OF  ITH  LEVEL  iN  JTH  PROFILE. 

THE  ATMOSPHER  IS  ASSUMED  TO 

BE  linear  along  A  PATH  BETWEEN 
THE  POINTS  AT  HEIGHT  LHT(I/J>  AND  RANGE  (LHT 
the  POINTS  AT  HEIGHT  LHT(I/ 

J)  AND„RANGE  PRNQ(J)  AND  THE  POINT 
AT  HEIGHT  LHT(I/J+l)  AND  RANG ( PRNG ( J+ 1 ) 

/ZREFL/  CONTRO.S  reflection  FROM  ELEVATED  LAYER# 
REFL».TRUE.  WHEN  REFLECTION  IS 

TO  BE  COMPUTED  (SET  BY  ^REFLECT  CAR 
LOSTi.TRUE.  when  DUE  TO  REFLECTIONS 

SIGNAL  has  become  TOO  WEAK  TO 
BE  FOLLOWEDD. 

STRENiSTRENGTH  OF  RAY  CURRENTLY 

(AS  FRACTION  OF  ORIGINAL  > 

STPSIQ*  strength  AT  WHICH  TO  STOP 

TRACING  (I  AS  A  FRACTION  OF  ORIGI 
LREFL*' LEVEL  NUMBER  OF  LAYER  TO 

BE  USED  FOR  REFLECTION. 

FREQpFREOUENCY  (IN  HERZ)  TO  BE 

used  in  callelating  attenuation 


SUBROUTINES 
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C  GETRAY, 

C  THIS  SuaROUTINE  INITIALIZES  /CURP6S/ 

FOR  THE  NEXT  RAY  TO  BE 
C  TRACEDt  IT  RETURNS  THE  VALUE 

.TRE.  IN  ITS  argument  IF  THERE 

C  IS  another  ray  to  Be  done  as  specified 

ON  the  trace  CARO* 
otherwise  it  returns  .False. 
htint(ht/Rnq) »  height  interpolation 

HT*  HEIGHT/  RNQ  =>  RANGE. 

THIS  Function  has  as  its  value 

THE  INDEX  OF  refraction  AT  THE 
given  height  and  range. 

IT  HAS  AN  alternate  ENTRY  POINT 

HTINTN  WHICH  IS  USED  FOR  THE  FIRST 
call  OF  A  RAY  TO  INITIALIZE  THE 

•window*  AT  T  WHICH  THE  FUNCTION 
IS  LOOKING,  after  THAT  THE  'WINDOW* 

MOVES  WITH  THE  RAY. 

GETCRD.  GET  CARDS 

THIS  ROUTINE  READS  CONTROL  CARDS 

WHICH  SET  VALUES  IN  COMMONS. 

IT  returns  after  IT  ENCOUNTERS  A  -"TRACE  CARD. 

BUMP.’ 

THIS  ROUTINE  PRFORMS  THE  ITERATIVE 
PROCESS  OF  determining 
THE  NEXT  POSITION  OF  THE  RAY. 

IT  TAKES  INTO  ACCOUNT  TURNING 

POINTS/  reflection  from  the  surface 
AND  reflection  from  a  Layer  (under  control  of  refd  . 
IT  calls  HTINT  , 

DFIND. 

THIS  IS  A  UTILITY  ROUTINE  USED 

TO  FIND  VALUES  IN  ARRAYS. 
print  (ENTRY  POINTSsSTRTRY  /  OUTPOS) 

THIS  subroutine  performs  the  printing 

STRTRY  IS  CALLED  WHENEVER  AN  ARAY 

IS  initialized.  (CALLED  BY  GETRA 
C  OUTPOS  IS  CALLED  (BY  MAIN)  FOR 

EVERY  POINT  COMPUTED.  IT  CALLS  PLT 

C  9UTKAY 

C  THIS  SUBROUTINE  IS  CALLED  WHENEVER 

A  RAY  IS  completed.  ITS  MaIN 
C  FUNCTION  IS  TO  CONTROL  THE  TAPES 

USED  IN  THGE  PLOTTING. 

C  OUTALL 

C  THIS  ROUTINE  IS  CALLED  WHENEVER 

A  GROUP  OF  ARRAYS  HAS  BEEN  COMPLEX 

c  IT  Performs  the  plotting,  it  is 

THE  only  routine  WHICH  CALLS  THE 
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c  puQtting  routines,  thus  if  the 

PROGRAM  IS  T8  BE  REWRITTEN  T8 
C  PRODUCE  PLOTS  USING  DIFFERENT 

SUBROUTINES  THIS  IS  THE  ONLY 
SUBROUTINE  WHICH  WOULD  HAVE  TO  BE  CHANGED. 

pltpos, 

CALL  TO  CONTROL  THE  PLOTTING  FOR 

EACH  POINT  (I.E.  IT  WRITES  INTERM 

TAPES. 

ATTEN.  FUNCTION  WITH  TWO  ENTRY  POINTS 
ATTEN  =  COMPUTES  THE  ATTENUATION 

COEFFICIENT  FOR  REFLECTION 
FROM  THE  ELEVATIED  LAYER  AND 

THE  ANGEL  AND  RANGE  SPECIFIED. 
SURFAT=  attenuation  due  TO  A  REFLECTION 
FROM  THE  SURFACE  AT  THE 
angle  SPECIFIED. 


CALL  PLINIT 

C  READ  control  CARDS/  AND  PROFILES 
100  CALL  GETCRD 

C  INITIALIZE  FOR  TRACING  A  RAY 
110  CALL  GETRAY(SUC) 

C  IF  NO  MORE  RAYS  HAVE  BEEN  SPECIFIED 

GET  MORE  C0NT0RL  CARDS. 

IF( .NOT.SUC)  GO  TO  160 
CALL  eUTPOS 
130  CALL  BUMP 

CALL  FINISH(SUC) 

DO  140  1*1/5 
140  CPOSd  )=NPBS(I  ) 

CALL  OUTPOS 
IF(SUC)  GO  TO  150 
GO  TO  130 

C  WHEN  RAY  IS  FINISHED  TAKE  APPROPRIATE  ACTIONS. 
150  CALL  QUTRAY 
GO  TO  110 

160  IF( .NOT. HOLD)  CALL  OUTALL 
GO  TO  100 
END 
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$IBFTC  XGETCR 

subroutine  GETCRD 

DOUBLE  PRECISION  PHT/PN/PRNG 
INTEGER  CTL{15)/TYPE 
INTEGER  PEND 

integer  DIhPl,DIMP2^DIMLl 
integer  TYPEliNAMES{3) 

LOGICAL  PRINT 

logical  hold 

DOUBLE  PRECISION  LHT 
REAL  PLFAR(6) 

REAL  PLTDEF(6) 
integer  T1/T8 
LOGICAL  PLOT/TEND/FIRSTR 
LOGICAL  REFL/LOST 

common  /ZREFL/  REFL/L0ST/STREN^STPSIG,lREFL/FREQ 
COMMON  /ZOIM/  DIMP1/DIMP2,DIML1 
common  /ZPLOT/  PLOT/PLFRNG/PLDRNQ, 

PLHLO/ PLHH I / PLDEN/ PLHQRD, 

X  THT(A0)/TRNG(40)/T1#T2^TEND^FIRSTR/NRAY 
common  /ZLEVEL/  LHT(20ilO)/NLEV 
COMMON  /ZTITLE/  TITLE! 13) 

common  /zprn/print 

common  /ZPROF/  PHTiaOO^ 10)^PN(200/ 

10)/PRNG( 10)/MAXP( 10)/NUMP 
COMMON  /ZTRCP/  STRTRG^STRTHT/STRTEL> 
STPRNG/BMPCT/VBMP/DEL 
common  /ZDELHT/DELHT 
COMMON  /ZHOLD/  HOLD 
dimension  TRCPAR(7) 
dimension  PARAM(7) 

DATA  (CTL( I I=l/l5)  /5H*PATH/ 

5H«ST0P<*5H»PR0F/6H*PRINT,6H*NOPRI/ 

X  6H*TRACE/5H»PL8T^6H*NOPUe^6H*DELHT/6H*REFLEi6H*N0REF^ 
X  5H*H8LD/6H*H0LDEia*O/ 

DATA  MAXTP  /15/ 

DaTa  (NAMES!  I  =  /SHRANGE/ 6HHE I GHT/ BHEL/ 

DATA  PEND  /5H*PEND/ 
data  LEV/6H*LEVEL  / 

DATA  PLTDEF/0./100»^0*/ 4000./ IOC •#900./ 

EQUIVALENCE  (PLFRNG^PLPaR! 1 ) ) 

EQUIVALENCE  ! STRTRG, TRCPAR ( 1 ) ) 

DOUBLE  PRECISION  I  NT# X, Y, XI/ X2/ Y1 # Y2 
INT!X/Xl/Yl/X2/Ya)  -  ! X-Xl ) / ! X2-X1 ) M YE-Yl )  +  Yl 
WRITE(6/911 ) 

C  READ  control  CARDS  AND  PROFILES, 

100  continue 

READ!5/900)  TYPE/TYPEJ/PARAM 
WRITE(6/906)  TYPE/TYPEI 
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DG  110  N’sl/MAXTP 


no  IF(CTL(N) .EQ»TYPE)  00  T0  (200/ 

250/300/350/360/400/500/600/370/ 
X  650/660/670/680  )  /  N 
WRITE(6j901)  TYPE/PARAM 
00  T0  100 
C  *PATH 

200  NUMPsO 

00  T0  100 


C  *ST0P 
250  STOP 
C  *PR0F 

300  NUMPpNUMP+1 

IF(NUMP  .GT.  0IMP2)  G0  T0  320 
PRNG(NUMP)  =  PARAM( 1 )»1000» 

WRlTE(6/907)  NUMP#PRNG(NUMP) 

IF(NUMP*GT.1  .and.  PRNG(NUMP) ,LE.PRNG(NUNP- 
1) )WRITE(6/919) 

IF(NUMP.GT»1  .and.  PRNG(NUMP) .LE.PRNG{NUNP- 
l))Ge  T0  321 

NsO 

C  the  ground  is  always  a  level 

NL  =  1 

LHT( 1/NUMP) *0. 

310  READ{5/902)  TYPE/PHT(N  +  l/NUMP)/PN(N+nNUMP) 
IF(TYPE.EQ.PEND)  G0  T0  340 
N  =  N+1 


PN(N>NUMP)  =1,+  PN(N/NUMP)*l.E-6 
IF(N.GE.DINPI)  G0  to  330 
IFdYPE.EQ.LEV)  G0  T0  340 
CAPN»  (PN(N/NUMP)-1. )*1.E6 
write (6/ 908)  TYPE/PHT(N/NUMP)iCAPN 
IF(N.GT.l  .AND.  PHT ( N/ NUMP ) , LT . PHT ( N- 
1/NUMP)  )  G0  T0325 

00  T0  310 

320  WRlTE(6/903) 

321  NUMPsNUMP-1 
00  T0  335 

325  WRITE(6.920) 

N  =  N-1 
G0  TO  310 
330  WRITE(6.904) 

335  READ (5/ 902)  TYPE 

IF(TYPE  .EQ.  PEND)  G0  T0  100 
60  T0  335 


C 

340  NL^NL+l 

LHT{NL/NUMP)sPHT(N/NUMP) 
CAPN=(PN(N>NUMP)-1. )*1.E6 
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WRITE (6^ 91 4)  NL/PHT(N^NUMP),CAPN 
IF(N.GTfl  .AND.  PHT ( N, NUMP ) . LT .PHT ( N- 
l^NUMP)  )  G0  T0325 

if(type.ne.pend)  Ge  le  310 

C 

345  WRITE(6/908)  type 
MAXP(NUMP) sN 

c  all  profiles  must  have  the  same  number  0F  levels 
IF(nuMP.EQ.1 )  NLEVsNL 
IF(NL.EQ.NLEV)  G0  to  100 
NLEV=MIN1(NL>NlEV) 

WRITE{6.917)  NLEV 
GO  TO  100 
C  SPRINT 

350  PRINT'.TRUE. 

GO  TO  100 
C  NOPRI 

360  PRINT*. FALSE. 

GO  TO  100 
C  *0ELHT 

370  DELHT  *  PARAM(l) 

WRITE(6^913)  DELHT 
G0  TO  100 
C  x TRACE 

400  D0  410  I=1W 
410  TRCPAR( I )*PARAM( I ) 

STRTRG=STRTRG*1000* 

STPRN6sSTPRNG*l000» 

READ(5/905)  TITLE 
IF(VBMP,EQ.1. )  DEL=DEL*1000. 

IF(VBMP.LT.1.  .or.  VBMP.GT.3.)  BMPCT»1. 
WR1TE(6^912)  TITLE 

WRITE (6# 909)  STRTRG/ STRTHT^ STRTEL/ STPRNG 

NBMpsVBMP 

MBMP*  E5MPCT 

IF(BMPCT  .GT.  1.)  WRITE(6/910) 

MBMP/ NAMES (NBMP),NBMP4 DEL 
C  INITIALIZE  parameters  F0R  PLOTTING, 

if{h0LD.and.  nray.ne.o)  return 

NRAYsO 

T1=2 

T2»3 

TEND  =  .TRUE. 
rewind  T1 
rewind  TE 
return 

C  «PLeT 

500  PLOT*. TRUE. 

DO  510  1*1/6 
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PLPARd  }  =PARAM(  I  ) 

510  IF(PaRAM( I ) .EQ.O* )  PLPARd )=PLTPEF(I ) 
PLFRNG*PLFRNG<H,E3 
PLDRNGbPUDRNG«1.E3 
WRITE(6/316)  PLPAR 
G9  T0  100 

c  i^NOPie 

600  PLOT*. false. 

G9  T0  100 
C  *REFLE 

650  REFL=*TRUE. 

LREFL^PARAMd  > 

IF(LREFL.EQ.O)  LREFL=2 
IF{PARA^'(2)  .LE.C»  )  PARAM(2)  »100. 
STPSIGs-A8S(PARAM{2) ) 

IF(PARA^',(3)  .EG.O. )  PARAMO)  550. 

FREG«PARAM0)  »1.E6 

WRITE  (6018)  LREFLOTPSIGOARAMO) 

GO  T0  100 
C  *N0REFL 

660  refl=. False. 

GO  T9  100 
C  ^fHOLD 

670  H9LD».TRUE. 

NRAYsO 
Q0  TO  100 
C  »HGLDE 

680  continue 

IF(HOLD)  call  9UTALL 
H9LD=. false. 

G9  T9  100 

900  F9RMAT(A6^ A4/7F10.9) 

901  F9RMAT(32H  FOLLOWING  CARD  IS  UNRECOGNIZED./ 

l//A6i4X.i7Fl0»4) 

902  FORMAT! A6/4X/3D10.0) 

903  format (19H  TOO  MANY  PROFILES.) 

904  FQRMAT(30H  PROFILE  HAS  JdG  MANY  HEIGHTS.) 

905  F9RMAT(13A6) 

906  format (5XiA6/A4) 

907  F0RMAT(lOX>7HPReFILEd3.3H  AT/ 

-3PF5.0/3H  KM/8X/6HHEIGHT/6X/ IHN  ) 

908  F0RMAT(5X/A6/28X/F7.0/F7.1  ) 

909  format d0X/12HSTART  RANGEr/ -3PF4.0/ 4H  KM./ 

2  10X/13HSTART  HE  I GHT*/ 0PF5 . 0/ 7H  METERS  / 

3  10X/16HSTART  ELEVAT I  ON-/ 0PF7 . 4/ 8H  RADIANS  / 

1  lOX/llHSTeP  RANGE*/ -SPFS.O/SH  KM  / 

X  ) 

910  FORMAT! 10X5HTRACE/ I3/6H  RAYS./ 

10X8HVARYING  A6/ lOH  (VARIABLE 
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X  I2/4H)  by/F13«4/Hh  each  time.  ) 

911  FORMAT(lHl) 

912  F0RMAT(1OX/13A6) 

913  F9RMAT(10X/6HDELHTsF5»0/8H  METERS.) 

914  Format ( 20X#  shlevel/ i 3# i ix, f? . O/ f? . i ) 

915  FeRMAT(40X/F8.0/3PF8.1) 

916  F0RMAT(lOXi 14HPUeTS  START  AT  -3PF5.0/4H  KM./ 

X  10X/19HEACH  FRAME  DISPLAYS  -3PF5.0/4H  KM./ 

X  10X/25HMINIMUM  HEIGHT  DISPLAYED»,0PF6.0# 3H  M./ 

X  10X/25HMAXIMUM  HEIGHT  DISPLAYED*/0PF6.0/3H  M,/ 

X  10X/23HQRID  LINES  APPR0X  EVERY/ 

0PF5.0/14H  raster  UNITS.  / 

X  10X/12HPLeT  HEIGHT*  0PF5*0/14H  RASTER  UNITS.  ) 

917  format (lOX/  4OHWR0NG  NUMBER  8F 

LEVELS/  LEVEL  COUNT  N0W/I3/1H*) 

918  F0RMAT( 10X/27HRAY  WILL  REFLECT  FROM  LEVEL/ 13/ IH.  / 
X  10X/33HTRACE  UNTiLL  SIGNAL  HAS 

DECREASED  0PF5.0/4H  DB,/ 

X  10X/20HRAY  HAS  FREQUENCY  0F/F6.0/6H  MGHZ.  > 

919  F0RMAT(10X/47HPReFILE  RANGES  MUST 

INCREASE,  profile  IGNORED.) 

920  FeRMAT(40X/46HHEIGHTS  MUST  INCREASE. 

PREVIOUS  POINT  ignored.  ) 

END 


f 
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$IBFTC  XGETRA 

SUBReUTINE  GETRAY(NEWRAY) 

C  INITIALIZE  CURPeS  FOR  THE  PLOTTING 

OF  another  RAY  ACCORDING  TO  THE 
C  control  INFORMATION  INZTRCP 
DOUBLE  PRECISION  HTINTN 

DOUBLE  PRECISION  SNELLC 

DOUBLE  PRECISION  ERAD 

DOUBLE  PRECISION  CHT # CTHET A, CEL/ CN/ CRNG 


LOGICAL  UP 

LOGICAL  NEWRAY 

LOGICAL  REFL/LOST 

INTEGER  Tl/TB 

LOGICAL  PLOT/TEND/FIRSTR 

COMMON  /ZPL0T/  PLOT/ PLFRNG/ PLDRNG, 

PLHLO/PLHHI/PLDEN^ PLHGRD/ 

X  THT(AO)/TRNG( A0)>T1/T2/TEND^FIRSTR/NRAY 
COMMON  /ZREFL/  REFL/LOST/STREN/STPSIG/LREFL/FREQ 
common  /ZTRCP/  STRTRG/STRTHT/STRTEL/ 
STPRNG/BMPCT/VBMP/DEL 
common  /CURPOS/  CHT/CTHETA/CEL/CN/CRNG 
COMMON  /ZRAD/ERAO 
COMMON  /ZSNELL/  SNELLC 
COMMON  /ZUP/  UP 
DIMENSION  TRCPAR(7) 

EQUIVALENCE  ( STRTRG/ TRCPAR ( 1 ) ) 

NEWRAY  =  »FALSE» 

IFCBMPCT.LT.  .1  )  RETURN 
C  there  WAS  ANOTHER  RAY  SPECIFIED, 

NEWRAYs.TRUE. 

CRNG=STRTRG 
CHT=STRTHT 
CEL  sSTRTEL 
CTHETA=CRNG/ERAD 
STREN=0, 

UP  =  CEL  ‘GE*  0, 

CN=  HTINT  (CHT/CRNG) 

SNELLC  »CN»( l.+CHT/ERAD)*DCeS(CEL) 
nray=nray+i 

IF(NRAY,GT.40)  WRITE(6/900) 

IF(NRAY.GT,  40)  NRAY=40 
callstrtry 


bmpct=bmpct-i. 

N=VBMP+.l 


IF(n,EQ.O)RETURN 

TRCPAR(N)sTRCPAR(N)+DEL 

RETURN 

900  FORMATIBSHOATTEMPT  to  plot  more 

THAN  40  RAYS  TOGETHER,  ONLY  40  USE 
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TRACE--GETRAY/  INlTIAtlZES  NEXT  RAY 

XD. ) 

END 
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$IBFTC  XBUMP 


C 

C 


SUBReUTINE  bump 
DeUBLE  PRECISI6N 
D0UBLE  PRECISION 
DOUBLE  PRECISION 
DOUBLE  PRECISION 
DOUBLE  PRECISION 
DOUBLE  PRECISION 
DOUBLE  PRECISION 
DOUBLE  PRECISION 
DOUBLE  PRECISION 
DOUBLE  PRECISION 
DOUBLE  PRECISION 
DOUBLE  PRECISION 
double  PRECISION 
LOGICAL  UP 
LOGICAL  ESCAPE 
LOGICAL  TURN 
LOGICAL  REFL/LOST 

common  /ZREFL/  REFL^LOST^STREN^STPSIG^LREFL/FREQ 

COMMON  /ZINTL/  HLIN1/HLIN2 

common  /NXTPOS/  NHT>NTHETA^NEL/NN/NRNG 


SNELLC 

ERAD 

NHT^NTHETA^NEL^NN,NRNG 
CHT^CTHETA.CEL/CN^CRNG 
HTINT/HTINTN 
CTAN,NTAN/XS0^ XDl/HALFPI 

darcos 

CeSEL^CRNiRNN 

HLINI/HLINH 

RBAR^HBAR/DENOMiDTHETA 

PHT/PNiPRNG 

LHT 

A/B/C/D/RT1/RT2 


common  /CURPOS/  CHT^CTHETA>CEL/CN^CRNG 
COMMON  /ZESC/  ESCAPE 

common  /zup/  up 
common  /zrad/erad 
common  /ZSNELL/  SNELLC 
common  /zdelht/  delht 

common  /ZIX/  IXP1WXP2/ IXHU  IXHEWXL^  IXPi  ixh 
common  /ZPROF/  PHT(200/ 10)/PN(200/ 

10)/PRNG( 10)>MAXP( 10)/NUMP 


common  /ZLEVEL/  LHT(20/ 10)/NLEV 
this  sets  up  the  next  point  FOR  STEP* 

IT  INCREMENTS  HIGHT>  AND  ELEVATION. 


LOST* .false. 

TURN*. false. 

100  CONTINUE 

C  HTLINl^  AND  HLIN2  ARE  THE  BOUNDS  IN 

WHICH  the  ATMOSPHERIC  MODEL  IS 
C  linear  around  THE  LAST  HEIGHT  FOR  WHICH  HTINT  WAS  CALLED. 
C  TO  insure  PROPER  TRACING,  ESPECIALLY 


NEAR  LAYERS  THESE  HEIGHTS  SHOULD 
C  BE  EXPLICITY  USED. 

IF (UP)  NHT*DMIN1(CHT+DELHT#HLIN2) 

IF(UP)  NHT=DMAX1(CHT+1.,NHT) 

IF( .NOT.UP)  NHT=DMAX1 (CHT-DELHT^HLINI) 

IF( .NQT.UP)  NHT*DMIN1 (CHT-1 .^NHT) 

C  SPECIAL  ACTION  IF  W£  GO  BELOW  Q  HEIGHT. 

IF(NHT  .GE.  0.)  GO  TO  150 
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TRACE-^OUMP/  ’BUMPS'  RAY  TO  NEXj  POSITION 


C  HAVE'NT  QUITE  REACHED  THE  SURFACE,  GQ  TO  IT  THIS  TIME, 
IF(CHT  ,GT,  0,)GQ  T8  140 
C  START  back  UP. 

C  MAY  WANT  A  NEW  PROFILE  FIRST. 

UP=.TRUE. 


CEL«ABS(CEL) 

IF(ReFL)  STRENsSTREN+AL0Q1O(SURFaT(CeL) ) 

IF(REFL)  L0STi.STREN.LT,STPSl6 
G0  T8  100 
140  NHT»0» 

150  continue 

C  NOTE,  IXL  IS  THE  VALUE  SET  BY  THE 

LAST  Call  T0  htint  which  should  have 
C  BEEN  THE  call  DURING  BUMP  F8R  CHT 

IFI.NBT.REFL  ,eR.  .not, up  .8R.  IXL.NE.LREFL)  go  to  160 
C  WANT  the  reflect  FROM  A  LAYER 
CELs-CEL 

C  CORRECT  F8R  LANT  8F  LAYER 

IF( IXPl.NE.IXPE)  CEL«CELt 

X  2,*0ATAN(  DBLEI  (LHTILREFL/ IXP2)-LHT(LREFL# IXPi ) )  / 

X  {PRNGnXPB)-PRNG(  IXPl )  )  )) 

UP«CEL.6E.O. 

C  recompute  SNELLS  CONSTANT 

SNELLCpCN*{1.+CHT/ERAD>*DC8S(CEL> 
STREN»STREN+AL0010(ATTEN(CEL^CRNG) ) 
LOSTiSTREN.LT.STPSIG 

ch 

CHT»  (LHTCLREFL^ IXPB)-LHT(LREFL/ 

IXPD)  •  (CRNQ"PRNG{  IXPl)  )  / 

*  {PRNGUXPE)  ^PRNG(IXPl))  +  LHT(LREFL/IXP1) 

CN»  « 

CNsHTINT(CHT^CRNG) 

GO  T0  100 

160  continue 

NN. htint (NHT/CRNG) 

C8SEL  »  SNELLC/(NN*( 1,+NHT/ERAD) ) 

C  CHECK  IF  WE  HAVE  REFLECTION 

IF(CO$EL  .GT.  I.IGS  TO  200 
NEL  iDARC0S{C0SEL) 

IF(,N0T.UP)  nel*-nel 
GO  T8  210 
C 

C  HERE  WHEN  WE  HAVE  A  TURNING  POINT. 

200  CONTINUE 

IF(CEL.N£,0. )  Ge  TO  202 
NHT»(CHT+NHT)/2. 

IF(ABS(NHT-CHT) .GT. .4)  GO  TO  HO 

NHTfCHT 

NEL«*CEL 
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trace;--^bumP/  tBUMPs*  ray  le  next  PosirieN  page  3 

IF(TURN)  GS  TQ  205 
TURN^ .TRUE» 
gps.NST^UP 
09  T9  100 

202  continue 

New  height  S0UUTI9N  OF  F91L0WING  QUADRATIC  EQUATION 
SNELLC*ERADs  (  CN+DnDH*  (  NHT-CHT  )  )  «  ( ERAD-t-NMT  ) 

WHERE  DNDH  15  LOCAL  DeRIVITIVE  OF  N 
DNDHb(NN«CN)/( NHT-CHT) 

AbDNDH 

B«0NDH*(ERAD^CHT)+CN 
C»ERAD*{CN-DNDH*CMT*SNELLC) 

DBSQRTIB^S-At^AtC) 

RTlstO^I-B+DI/A 
RT2*«5»(-B-D)/A 

Hb(cht*rti)*(nht-rti) 

THs{CHT-RT2)*(NHT-RT2) 

NHT»RT2 

IF(T1«LE»0*0»AND» (T2.GT»0»0»0R»T2.LE.0.0*AND.ABS(T1^ 
CHT)»LE* 

1ABS(T2«CHT)  )  )  NHTbRTI 

IF{Tl»GEtO*0»AND*TS.GE*0’0*AND.Tl«LT.T2)  NHTpRTI 
IF(T1.GT.0*0»AND*T2.GT.0*Q)  go  to  205 
NEL^fO* 

NN*SNELLC/{1»*NMT/ERAD) 

UPa,NeT»UP 

IF(TURN.ANDt  ABS(NHT»CHT)fLT‘.OOl)  GO  TO  205 
TURN««TRUE. 

IF(ABS(NHT^CHT).LT*.001)  go  TO  loo 
GO  TO  210 
C  WAVE  IS  JUST  FOLLOWING  CURVQTURE 
205  DTHETA»»0015 
GO  TO  250 

C  NOW  WE  complete  THE  NEW  POSITION  OF 

the  ray  by  determining  theta  AND 
C  RANGE.  THIS  ROUTINE  USES  FORMULA'S 

derived  by  GARDINER.  SEE 
C  PACIFIC  MISSLE  range  TECHNICAL  NOTE  3280-6. 

C  determination  of  ELEVATION  AND  SLANT 

RANGE  errors  due  TO  ATMOSPHERIC 

C  REFRACTION. 

210  continue 

RBAR».5*(CN+NN) 

HBAR  ?  (CHT+NHT)/2. 

DENOM  s  {NN-CN)»(HBAR+ERAD)  ^  RBaR* ( NHT-CHT ) 
IF(DABS(0EN0M) .LT.  .01)  GO  TO  300 
DTHeTA  *  (NEL-CEL>*RBAR*{NHT-CHT)/DeNOM 
IFIDTHETA  .LT.  O.DO  .or.  DTHETA  .GT.  ,OlDO)  GO  TO  300 
250  continue 
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TRACE-eBUMP/  »BUMPS»  RAY  T8  NEXT  PesiTION  PAGE  4 

NTHETAbCTHETA  +  dtheta 
NRNQ  *  NTHETA*ERAD 
RETURN 

C  0EN0MINAT8R  IS  T80  SMALl,. 

C  this  SHeuLDNtT  HAPPEN  9FTEN»  WHEN 

IT  DOES  USE  ALTERNATE  F9RM 

c  eF  equations. 

300  continue 

CTAN  *  OSIN(CEL>/DC0S(CEL) 

NTAN*  DSIN(NEL)/DC0S(NEL) 

XSQ«  (  (NTAN-CTAN)/{ l.+NTAN#CTAN) 

XDIk  (NN*{NHT-CHT)*{ If /OC0S(CEL>+1»/PC8S{NEL) ) )/ 

X  (SNELLC*(NTAN+CTAN)*( 1.+NTAN*CTAN)*eRAD) 

DTHETA«X01«(  l.+XSQ/3f -XSQ»XSQ/5»+XSQ*xS0'‘XSQ/7t ) 

GO  TO  350 
END 


TRACE"-HTINT4  INTERPQUAIES  N 
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$IBPTC  XHTINT 


D8UBLE 
c  returns  the 

D0UBLE 

Q9UBLE 

D8UBEE 

DOUBLE 

DOUBLE 

DOUBLE 

DOUBLE 

LOGICAL 

DOUBLE 

LOGICAL 

LOGICAL 

COMMON 

COMMON 

COMMON 

COMMON 

common 


PRECISION  FUNCTION  HT INT ( HT# RAMGF ) 
INDEX  OF  refraction  AT 

THE  GIVEN  height  AND  RANGE. 
PRECISION  HT^RANGE 
PRECISION  INT/X,X1/X2/Y1/Y2 
precision  LlNT^REL/HTl/HTa 
PRECISION  LINTHI ,LINTLe 
PRECISION  LHT 
PRECISION  PHT/PN#PRNG 
PRECISION  HHN1jHLIN2 
LAYER 

PRECISION  HTREL 
ESCAPE 
ESC 

/ZINTL/  HLIN1/HLIN2 

/7P«?C/  pcjrAPF 

/ZPR0F/  PHT(200/ 10)iPN{200i 

10)iPRNG( 10),MAXP(10)/NUMp 
/ZLEVEL/  LHT|2Q/10)/NLEV 
/ZIX/  IXPl, IXP2, IXHl, IXH2/ IXL, ixp, IXH 


C 

lNT{X/Xl/Yl/Xp,Y2)  =  (XwX1)/(X2*X1)MY2-Y1)  +  Yl 
C 

C  HTINTN  IS  CALLED  AT  THE  BEGINNING  OF  a  RAY. 

ENTRY  HTINTN(HTiRANGE) 


100  CONTINUE 
C 

C  TEST  IF  there  IS  TO  BE  INTERPOLATION  IN  HEIGHT  ONLY 
IXP»1 

IF(NUMP.E0«1 >  GO  TO  310 


C 

C  FIND  THE  profiles  FOR  RANGE  INTERPLAT ION. 

CALL  DFIND(  RANQE^PRNG#NUMIMXP1,ESC) 

ixpe»ixpi+i 

C  IF  PAST  last  profile  USE  IT  ONLY 
IF(ESC)  go  to  300 

C  IF  THERE  are  LEVELS  FIND  OUT  WHICH  ONE  THIS  IS  IN. 
IF(NLEV.EQ.I)  go  TO  210 
NLsNLEV^I 
DO  200  IXLsl^NL 

LINTHI»INT(  range#  PRN6(IXPl)/  LHT ( I XL+ 1 # I XPl ) # 
X  PRNGnXP2)/LHT(  IXL+l#  IXP2)  ) 

200  IFILINTHI tGE.HT)  GO  TO  220 
210  HTIrHT 
HT2-HT 


GO  TO  230 

220  LINTLe«INT(RANGE#PRNG{ IXP1)#LHT( I  XL# I XPl ) # PRNG { I XP2 ) # 
X  LHT( IXL# IXP2)  ) 
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TRACE--HTINT/  INTERP8LATES  N 


PAGE  2 


REL=  (HT-LINTUO)/(LINTHI-11NTL0) 

HT1cLHT( IXL^ IXPl )  +  REL*(LHT(IXl+ 

1/IXPl)  -LHT( IXL/ IXPl ) ) 

HTEsLHTdXL^  IXPE)  +  REL*  ( LHT  ( I  XL  + 
ldXP2)  -LHK  IXLdXPE)  ) 

230  CALL  DFIND(HT1/PHT( X/IXPl )/MAXP( IXPl ), IXHdESC) 
ESCaPEsESC 

CALL  DFIND(HT2iPHTadXP2)/MAXP(  IXP2)  /  IXH2,ESC> 
EGCaPE=ESC.8R. ESCAPE 

RNlslNKHTl,  PHT(  IXHldXPl  )/PN(  IXHl/  IXPl  )/ 

X  PHTdXHX  +  1/ IXPI  )/PN(  IXHl  +  1/ IXPI  )  ) 
RN2sINT(HT2/  PHT(  lXH2dXP2)/PN<  IXH2/  IXP2)^ 

X  PMT{  IXH2  +  ldXP2)/PN(  IXH2+ldXP2)  ) 
HTINT«INT(RANGE#PRNG( IXPl)^RNdPRNG( IXP2)/RN2  ) 
HLINI-DMAXI ( 

X  INT(PHT( IXHl/ IXPl )^UHT( IXL/ IXPl 

LINTLQ/LHT( iXL+a# IXPI )^LINTHI 
X  INT  (FHT(  IXH2dXP2)/LHT(  IXLdXP2)/ 

LINTLe/LHT( IXL  +  li I XP2 ) / L I  NTH  1) ) 
HLIN2='DMIN1( 

XINT(PHTdXHl  +  ldXPl),LHTnXLdXPl)# 

LINTLeiLHK  IXL+ldXPDiLINTHI  )/ 
XINT(PHT{ IXH2+1/ IXP2)/LHT( IXL/ IXP2)^ 

LINTL0/LHT( IXL+1, IXP2)#LINTHI ) ) 

RETURN 

C  cePiE  HERE  WHEN  THERE  IS  ONLY  8NE  PR8FILE  T8  BE  USED 
300  C0NTINUE 
IXP^:IXP2 

lF(RANGEtLE«PRNG( 1 ) )  IXP«1 
C  interpolate  THE  INDEX  IN  THAT  PROFILE 

310  CALL  DFIND(HT/PHTUdXP)/MAXP(  IXP  )dXH, ESCAPE) 
HTINT»INT(HT,PHT( IXH/ IXP)/PN( IXH# IXP), 

X  PHTdXH+ldXP).PN(  IXH+1/ IXP)  ) 

HLIN1»PHT< IXH^ IXP) 

HLIN2-PHT(  lXH4d  IXP) 

C  F8R  USE  IN  CASE  OTHER  ROUTINES  WANT  TO  LOCATE  RAY 
IXPldXP 
IXP2=1XP 
IXHl^IXH 
IXH2»IXH 

CALL  DFIND(HT^LHT (1 / I XP ) > NLeV/ I  XL/ ESC ) 

return 

END 
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TRACE"-DFIND^  utility  routine 


PAGE  1 


TIBFTC  XDFIND 

SUBROUTINE  DFIND{X/DATA/LIM,L1>  ESC) 

DOUBLE  PRECISION  DATAIDjX 
LOGICAL  ESC 
C 

c  this  subroutine  locates  the  entrys 

IN  A  table  of  ascending  values 
c  which  bracket  X. 

C  DATA  IS  the  table.  IT  HUST  BE  ARRANGED  IN  ASCENDING  0RD£R. 
C  I.E.  DATA(I)  ,LE.  DATA(I+1) 

C  LIM  IS  the  number  OF  ENTRIES  IN  THE  TABLE. 

c  LI  ON  Return  is  the  lower  side  of  the  bracket,  i.e. 

C  DATA(LI)  .LE.  X  -LE.  DATA(L1+1) 

c  if  X  falls  outside  the  table  esc  is 

SET  true#  and  LI  is  SET  TO  l 
C  OR  LIM-1  DEPENDING  ON  WHETHER  X  IS 

below  or  above  THE  RANGE  COVERED 

C  BY  THE  table. 

C 

C  IF  LI  ON  ENTRY  IS  WITHIN  THE  LIMITS 

OF  the  TABLE#  THE  SEARCH  FOR 
C  LI  WILL  START  FROM  ITS  CURRENT  VALUSE. 

(THIS  WILL  MAKE  REPEATED 
CALLS  MORE  EFFICIENT  IN  MANY  CASES). 


ESCv. FALSE. 

IFCLI.GT.O. AND.L1.lt. LIM)  GO  TO  110 
Lin 

no  continue 

IF(DATA(L1 ) .GT.X)G0  TO  150 
IF(DATA(L1+1 )  .GT.  X)  RETURN 
Ll-Ll+l 

IF(L1.LT.LIM)G0  to  110 

L1=LIM-1 

GO  TO  200 

150  IFILI.LE.I )G0  TO  200 
Ll^Ll'l 
GO  TO  110 

200  continue 

210  ESCs.TRUE. 

RETURN 

END 
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i-IBFTC  XATTEN 

real  FuNCTIBN  ATTEN(EU^RNG) 

C  COMPUTE  the  REFLECTIBN  COEFFICIENT 

F8R  the  specified  LAYER  AT  THE 

c  given  Range  fbr  a  ray  with  the  given  elevation* 

DOUBLE  PRECISION  EL/RNG 
double  precision  PHT/PN#PRNG 
DOUBLE  PRECISION  LHT 
logical  REFL/LOST 

common  /ZREFL/  REFL/L0ST/STREN/STPSIG,LREFL#FREQ 
COMMON  /ZIX/  IXPl,  IXPa^  IXHI,  IXHB/ IXLMXPWXH 
common  /ZPROF/  PHT(200/lO)/PN(200i 

10)^  PRNG ( 10 ) ^  MAXP (10)/ NUMP 
common  /ZLEVEL/  LHT(20/10)/NLEV 
data  pi/3. 141592/ 

C  TEST  IF  THERE  IS  ONLY  ONE  KPR0FILE. 

X»0* 

IF(IXP1.EQ.IXP2)  GO  TO  110 

Xs  (RNG-PRNG(  IXPl)  )/(PRNG(  IXP2)<.PRNG(  IXPl)  ) 

110  CONTINUE 

HT=(l«-X)*LHT(LREFLiIXPl)  +  X»LHT ( LREFL# I XP2 ) 

SLOPE=  (HTINT(HT+10./RNG)-HTINT(HT  /RNG))  »l.E-7 
VATTEN»SL0PE*(3»E8/FREQ)/(8.*PI<tSIN{EL)**3) 

ATTEND AMINl  (VATTEN**2n.  ) 

RETURN 

ENTRY  SURFAT(EL) 

C  COMPUTE  REFLECTION  COEFFICIENT  FROM  SURFACE* 

C  USE  FORMULAS  FROM  ESSA  TECH.  REPT. 

ERL  79-ITS  67/  PAGE  0-4* 

C  ASSUME  WAVE  HEIGHT  OF  3  METERS. 

DATA  WHT/3./ 
data  PI/3.14159/ 

VATTENs  AMAXI (EXP(-2**PI*.39*WHT*SIN(EL)/(3.E8/FREG) )/ 
X  SQRT(A8S(SIN(EL) >  )  ) 

ATTEN  =  VATTENi**2 

RETURN 

END 
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SIBFTC  XPRINT 

SUBR0UTINE  STRTRY 

DOUBLE  PRECISION  CHT/ CTHETA, CEL/ CN/ CRNG 
LOGICAL  PRINT 
logical  REFL/LOST 
C 

COMMON  /ZREFL/  REFL/LOST/STREN/STPSIQ/LREFL/FREO 
common  /ZPRN/PRINT 
common  /ZTITLE/  TITLE! 13) 
common  /CURPOS/  CHT/CTHETA/CEL/CN/CRNG 
c 

IF( .NOT. PRINT)  GO  TO  300 
WRITE{6/504) 

WRITE(6/90B)  TITLE 
WRITE(6/900) 

WRlTE(6/902) 

WRITE(6/903) 

NCTsC 

RETURN 

ENTRY  QUTP0S 
CALL  PLTPOS 
IF( .not. PRINT)  RETURN 
200  C0RN=(CN-1.)*1.E6 

write (6/ 901 )  CRNQ/CHT/CEL/CORN/CTHETA 
NCT^NCT+l 


300 


IF(NCT.LT.50 

NCT^O 

WRlTE(6/904) 

WRITE(6/900) 

WRITE(6/902) 

WRITE(6/903) 

RETURN 

WRITE(6/906) 

RETURN 

ENTRY  OUTRAY 
WRITE(6#907) 
CALL  PLTRAY 


RETURN 


CHT/CRNG/CEL 

CHT/CRNG/CEL/STREN 


RETURN 

900  FORMAT! 10X/5HRANGE/9X/6HHEIGHT/ 

6X/9HELEVATI0N/  llX/ifHREF./lOX/ 

X  5HTHETA) 

901  F0RMAT!-3PF15.4/0PF15.1/F15.4/F15.1/E15.3) 

902  FORMAT! lOX/ 5! 2HIN/ 13X ) /i2X3HKM. / 

9X6HMETERS/8X7HRADIANS/8X7HN  UN 
X  8X7HRADIANS) 


TS 


903  FORMAT! IHO) 

904  format !1H1) 

905  format !20X/8HNEW  RAY/ 5X/ 13A6/1X ) 

906  FORMAT! IH0/9X/ 13HSTART  HEIGHT=F6.0/ 

3H  M./5X12HSTART  RANGE=/ 
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X  -3PF5.0/4H  KM./5X9HSTART  EL»0PF8.4/5H  RAD.  ) 
907  format (IIX/ lEHSTeP  HEIGHTsF6»0^ 

3H  M./6XUHST0P  RANGEs-3PF5.0/ 

X  4H  Kh./6X8HST0P  EL*0PF8 . 4/ 5H 

RAD./6X/ 12HATTENUATI0N5F6.O/4H  DB. 

END 


PAGE  2 


) 
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$IBFTC  XFIN 

SUBROUTINE  FINISHCDONE) 

DOUBLE  PRECISION  CHT. CTHET A, CEL# CN, CRNG 
DOUBLE  PRECISION  NHT# NTHETA# NEL# NN# NRNG 
LOGICAL  ESCAPE 
LOGICAL  DONE 
LOGICAL  REFL#L0ST 

COMMON  /ZREFL/  REFL#L0ST/STREN#STPSIG#LREFH#LREFL2 
common  /CURP0S/  CHT/CTHETA/CELiCN#CRNG 
COMMON  /NXTPOS/  NHT# NTHETA# NEL/ NN# NRNG 
common  /ZTRCP/  STRTRG/STRTHT/STRTEL/ 

STPRNG#BMPCT# VBMP/DEL 
common  /ZESC/  ESCAPE 

done*  NRNG.GEtSTPRNG  .OR.  ESCAPE  .OR.  LOST 

ifinrng.le.stprng)  return 
X  = ( STPRNG-CRNG ) / ( nrng- CRNG ) 

NRNQsSTPRNG 
NHT*CHT+  X^INHT-CHT) 

NTHETA=CTHETA+  X*(NTHETA-CTHETA) 

NEL*CEL+X*(NEL-CEL) 

NN=CN+  X*(NN-CN) 

RETURN 

END 
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$IBFTC  TRCBLK 

BLOCK  DATA 

DOUBLE  PRECISION  ERAD 
INTEGER  DIMPl^OIMPB^DIMH 
LOGICAL  HOLD 

common  /zhold/  hold 

COMMON  /ZDIM/  DIMPl,DIMP2i DlMLl 
COMMON  /ZRAD/ERAD 
COMMON  /ZHTLAY/  HTUAY. 

COMMON  /ZDELHT/  DELHT 
DATA  ERAD/  6371, aD3/ 

DATA  DIMP1^DIMP2  /200#10/ 

DATA  DIMLl  /20/ 

DATA  HOLD/, false./ 
data  DELHT  /20./ 

END 
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$IBFTC  XPETRA 

SUBR9UTINE  PLTRAY 

INTEGER  T1/T2 

LOGICAL  PLOT^TEND/FIRSTR 

LeOlCAL  PRINT 

CeMM0N  /ZPRN'/PRINT 

C8Mr^9N  /ZPL0T/  PLOTj  PLFRNG/ PLDRNG^ 

PLHL0^ PLHHI/PLDEN/PLHGRD/ 

X  TriT(40)-'TRNG(40)/Tl^T2/TEND/FlRSTR^NRAY 
C  this  routine  finds  the  end  of  TAPE  T1  AND  MARKS  IT.  0N  T2. 

IF( ,N0T.PLeT)  return 
C  IF  already  at  end  G0  mark  T2 
IFaEND)  GO  TO  120 
110  READ(TI)  THT^TRNG 

IF(THT(1).LT.-5.)  go  to  120 
THT(NRAY)=-1. 

WRITE(T2)  THT^TRNG 
GO  TO  110 

C  AT  END  OF  TAPE  MARK  IT* 

120  CONTINUE 

DO  125  Nsl/NRAY 
125  THT(N)=-1. 

THT(1)=-10. 

WRITE(T2)  THT^TRNG 
ENDFILE  T2 

rewind  T1 
rewind  T2 

C  SWITCH  ROLES  TO  Tl  AND  T2. 

I=Ti 
T1  =  T2 
T2M 

C  NO  LONGER  ON  FIRST  RAY  OR  AT  END  OF  TAPE 
TEND^. false. 

RETURN 

900  FORMAT! 1H0/9X> 12HATTENUAT ieN=F5.C/4H  DB. ) 

END 
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$IBFTC  XOUTAL 

SUBROUTINE  OUTAUL 

LOGICAL  MORE 

LOGICAL  over 

LOGICAL  HOLD 

REAL  THTX(40)^TRNGX(40) 

INTEGER  TIN 

integer  T1/T2 

LOGICAL  PLOT^TEND/FIRSTR 

LOGICAL  PRINT 

COMMON  /ZPRN/  PRINT 

common  /zhold/  hold 

COMMON  /ZTITLE/  TITLE(13) 

COMMON  /ZPLOT/  PLOT^PLFRNG/PLDRnG/ 

PLHL0/ PLHHI , PLDEN/ PLHGRD, 

X  THT  (40)/TRNG(40)i-Tl/Ta/TEND^F|RSTR^NRAY 

c  this  routine  uses  the  tape  produced 

BY  0UTPOS  AND  OUTRAY  TO  PLOT 

C  THE  RAY  PATHS. 

iF( .not.plot)  return 

MORE*. TRUE. 

TIN=T1 

FRMRNGsPLFRNG 
190  TORNGsFRMRNG  +  pldrng 
IF( .NOT. MORE)  RETURN 
MORE*. false. 

rewind  tin 

CALL  SETMIV(50/0/50/1023-50-IFIX(PLHGRD) ) 

CALL  DXDYV(1/FRMRNG/1000./T0RNG/ 

1000./DX^N> I#NX/PLDENi IERR) 

CALL  DXDYV(2/PLHL0iPLHHI#DY/M/ J#NY/PLDEN/ I ERR) 

CALL  GR I Dl V ( 3/ FRMRNG/1000 . t TORNG/IOOO ♦ $ PLHLO^  PLHH I » 

X  DX/DY/N/MW/U^NX>NY) 

CALL  RITE2V(300/20#1000  ^90^X/30>  -1^ T ITLE/ lERR ) 

C  READ  IN  the  RIST  POINTS 
220  READ(TIN)  THTiTRNG 
C  READ  IN  the  NEXT  SET  OF  POINTS 
230  READ(TIN)  THTX^TRNGX 

WRITE(6/1)  (THTXd )/TRNGX( I)/  Iei>NRAY) 

1  FORMAT! lOFlO.O) 

C  IF  AT  END  OF  TAPE^  WE  ARE  DONED. 

IF(THTX(1)  .GT.  -50  GO  TO  240 

FRMRNGsTORNG 

IF(M0RE)  go  to  190 

RETURN 

240  OVER*. TRUE. 

DO  300  N?1/NRAY 

MOREsMORE  .or.  < TRNGX(N) .GT.TORNG  .AND.  THTX ( N ) . GE .0 . ) 
IF(  TRNGX(N) .LE.T0RNG  .AND.  THTX(N) .GE.Q* ) 

OVERS. false. 
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IF(THT(N) .LT.O.  .OR,  TRNGX(N) .LT.FRMRNG 
eOR,  TRNG(N) .GT.TORNG) 

X  GO  TO  290 

IF(TRNG(N) .EQtTORNG  .OR.  TRNGX(K) .EQ.FRMRNG)  GO  TO  290 
IF(THTX(N) .GT.PLHHI )  GO  TO  290 

IF(TRNG(N) .GE.FRNRNG.AND,TRNGX(N) .LE.TORNQ)  GO  TO  270 
IF(TRN6(N)  .LT.  FRMRNG)  go  to  260 

c  at  end  of  frame. 

THTX(N)=THT  (N)+  ( T0RNG-TRNG ( N ) ) / ( TRNGX ( N ) -TRNG ( N ) )  * 

X  (THTX(N)-THT<N) ) 

TRNGX(N)=TeRNG 
GO  TO  270 

C  AT  start  of  frame. 

260  THT(N)=THT(N)  +  (FRMRNG-TRNG(N) )/(TRNGX{N)-TRNG(N) )♦ 

X  (THTX(N)-THT{N) ) 

TRNG(N)  =:FRMRNG 
270  CONTINUE 

C  HAVE  A  RAY  SEGMENT  TO  PLOT/  ALSO 

INDICATE  THAT  THE  MAY  STILL  BE 
C  MORE  POINTS  TO  PLOT. 

NH=5NYV(THT(N)  ) 

NR=  NXV(TRNG(N)/1000. ) 

NHXsNYV{THTX(N) ) 

NRX=NXV(TRNGX(N)/10Q0, ) 

IF(NH.NE.0  .and.  NR.NE.O  .and. 

nhx.ne.o  .and.  NRX.NE.O) 

X  CALL  LINEV(NR/NH>NRX/NHX) 

290  TRNG(N)sTRNGX(N) 

THT(N)=THTX(N) 

300  continue 

IF( .NOT.OVER)  go  to  230 
C  HAVE  FINISHED  A  FRAME. 

frmrng=torng 
GO  to  190 
ENTRY  PLINIT 

GARBAGE  FOR  PLOTTING  STARTUP 
external  TABLIV 
CALL  RITSTV{24/17^TABL1V) 

CALL  RITE2V  (1OO/5OO/1OOO>9O/1W/-1/7HWILS0N  ^N) 

C 

H0LD=*FALSE. 

PRINT*. FALSE. 

PLOT* •false. 

RETURN 

END 
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$IBFTC  XPLTPe 

SUBR0UTINE  PLTP8S 

D8UBLE  PRECISI0N  CHT/ CTHETA, CEL/ CN^ CRNG 
LBGICAL  PL8T/TEND/FIRSTR 
INTEGER  T1/T2 

CeMN8N  /CURPeS/  CHT/CTHETA/CEU/CN/CRNG 
C0MM0N  /ZPLei/  PL8T/PLFRNG/PLDRNG, 

PLHL0/ PLHH I / PLDEN/ PLHGRD/ 

X  THT(40)/TRNG(40)/T1/T2/TEND/FIRSTR/NRAY 
C  this  SUBRBUTINE  eUTPUTS  A  TAPE  WHICH 

WILL  LATTER  BE  USED  T8 

C  PRODUCE  A  PL8T. 

C  each  LOGICAL  RECORD  CONTAINS  THE  HEIGHT 

AND  range  0F  up  T04O  RAYS. 

C  A  NEGATIVE  HEIGHT  INDICATES  THAT  THERE 

IS  D  NO  Data  present  for  that 
C  RAY  IN  this  record.  A  VALUE  .LT. 

-5.  FOR  THE  FIRST  HEIGHT  INDICATES 
C  that  THIS  IS  THE  END  OF  THE  TAPE.  (I.E.  A  LOGICAL  EOF). 

C 

IF( -NOT. PLOT)  return 
C  EXCEPT  FIRST  RAY/  OR  WHEN  END  OF  TAPE 

IS  REACHED  READ  IN  AN  OLD 

C  RECORD. 

IF  (  TEND)  GO  TO  200 

READ(Tl)  THT/TRNG 
C  TEST  F0R  END  OF  TAPE. 

IF(THT(1)  .GE.  -5.)  GO  TO  200 
TEND  s.TRUE. 

THT{1)--1. 

C  WILL  USE  THTU)  in  WRITTINC  SO  DON'T  LET  IT  BE  -10. 

200  THT(NRAY)  «  CHT 
TRNQ(NRAY) sCRNG 
WRITE(T2)  THT/TRNG 
RETURN 
END 
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TRACE'-DARCeS/  D0UBLE  PRECISION  ARC  CesiNE 
«IBFTC  XARCeS 

^DOUBLE  PRECISION  FUNCTION  DaRCOSIX) 

DOUBLE  PRECISION  X 

DOUBLE  PRECISION  PI 

data  pi  /3. 14159E653589793D0/ 

DARCeS?  DATAN(DSQRT(1*D0-X*X)/X) 
IF(X.LT.O.DO)  DARCOS-PI+DaRCOS 
RETURN 
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